@@ -1,5 +1,117 @@
This file documents the revision history for Perl extension Mojolicious.
+0.999933 2010-10-30 00:00:00
+ - Fixed small connect bug in Mojo::IOLoop.
+ - Fixed WebSocket handshake.
+
+0.999932 2010-10-29 00:00:00
+ - Deprecated the old plugin hook calling convention and added
+ EXPERIMENTAL hook method to Mojolicious.
+ - Fixed a few small connect bugs in Mojo::IOLoop.
+ - Fixed typos.
+
+0.999931 2010-10-25 00:00:00
+ - Removed tag helpers label and img.
+ - Renamed tag helper script to javascript and added CDATA support.
+ - Renamed tag helper input to input_tag.
+ - Added EXPERIMENTAL non-blocking DNS support to Mojo::IOLoop.
+ (und3f)
+ - Added EXPERIMENTAL support for IPv4 and IPv6 addess checks to
+ Mojo::URL.
+ - Added stylesheet tag helper.
+ - Added before and after methods to Mojo::DOM.
+ - Hide command overview from prove. (omega)
+ - Default to silent tests in Test::Mojo.
+ - Fixed optional value support in Mojo::Cookie.
+ - Fixed shortcut methods in Mojo::Headers to not be context aware.
+ - Fixed url_for to not inherit captures for new endpoints.
+
+0.999930 2010-10-18 00:00:00
+ - Code name "Hot Beverage", this is a major release.
+ - Removed Mojo::Server::Daemon::Prefork due to unfixable design flaws
+ regarding WebSocket support, please use a PSGI server instead for
+ HTTP production setups.
+ For scalable WebSocket deployment we will introduce a whole new
+ server in one of the next releases!
+ - Deprecated old Mojo::Template block syntax and added a very pretty
+ replacement. (See documentation for more)
+ - Deprecated helper method in Mojolicious::Controller.
+ - Deprecated all *_cb methods (and finished/receive_message) in favor
+ of on_* methods.
+ - Deprecated process method in Mojo::Client and added new start
+ method.
+ - Replaced the "mojolicious" command with "mojo", for convenience.
+ - Removed Mojo::Command::Generate::App.
+ - Renamed the methods name and replace_content to type and
+ replace_inner in Mojo::DOM.
+ - Added EXPERIMENTAL support for indented Perl lines in
+ Mojo::Template.
+ - Added EXPERIMENTAL support for --mode and --home options to all
+ Mojolicious commands.
+ - Added EXPERIMENTAL support for helper methods.
+ - Added EXPERIMENTAL helper method to Mojolicious.
+ - Added EXPERIMENTAL support for inline rendering to Mojolicious.
+ - Added EXPERIMENTAL memorize helper to
+ Mojolicious::Plugin::DefaultHelpers. (ptomli)
+ - Added EXPERIMENTAL write, write_chunk and rendered methods to
+ Mojolicious::Controller.
+ - Added EXPERIMENTAL support for loading of plugins by full module
+ name.
+ - Added EXPERIMENTAL tag helpers to Mojolicious.
+ - Added EXPERIMENTAL support for radio buttons and select fields to
+ Mojolicious::Plugin::TagHelpers. (kvorg)
+ - Added EXPERIMENTAL is_limit_exceeded, max_line_size and
+ max_message_size methods to Mojo::Message.
+ - Added EXPERIMENTAL automatic relaxed parsing support for HTTP
+ responses.
+ - Added while, until and inner_xml methods for Mojo::DOM collections.
+ (vti)
+ - Added b function to all Mojo::Template templates.
+ - Added selector support to the dom method of Mojo::Message. (marcus)
+ - Added x function to ojo. (DaTa)
+ - Added failed request warnings to ojo. (marcus)
+ - Added support for selector groups to Mojo::DOM.
+ - Added more attribute selectors, pseudo classes and combinators to
+ Mojo::DOM.
+ - Added support for mode specific config files to
+ Mojolicious::Plugin::JsonConfig. (marcus)
+ - Added reserved route name current.
+ - Simplified transaction pausing by replacing it with an automatism.
+ - Improved RFC3986 compliance of Mojo::Path. (janus)
+ - Improved Mojo::Server::PSGI to preload applications.
+ - Improved FastCGI detection for Dreamhost. (garu)
+ - Improved keep alive timeout handling in Mojo::Client.
+ - Improved documentation. (rhaen)
+ - Improved Mojo::ByteStream performance. (mons)
+ - Improved Mojo::Parameters performance. (kimoto)
+ - Improved Mojo::Message::Response parser resilience.
+ - Improved template class handling in MojoX::Renderer. (vti)
+ - Fixed a serious design flaw in Mojo::Message and made long poll
+ much easier.
+ - Fixed a bug where Mojo::IOLoop connections could be closed too
+ early.
+ - Fixed a bug where a broken renderer could cause a fatal exception.
+ - Fixed HTTPS support for CGI environments.
+ - Fixed a auto rendering bug related to bridges.
+ - Fixed Mojo::IOLoop Windows support.
+ - Fixed Mojo::DOM class selector bug. (tempire)
+ - Fixed small render bug. (skaurus)
+ - Fixed a small renderer bug.
+ - Fixed automatic reloading for external templates.
+ - Fixed after_build_tx plugin hook callback order.
+ - Fixed a small under bug in Mojolicious::Lite.
+ - Fixed logging of UTF-8 errors. (und3f)
+ - Fixed Mojo::DOM parser bug. (esskar)
+ - Fixed TLS handshake bug in Mojo::IOLoop. (und3f)
+ - Fixed a small Test::Mojo bug.
+ - Fixed multiple route condition bugs. (esskar)
+ - Fixed a small relative path bug in Mojo::URL.
+ - Fixed pod renderer bug. (vti)
+ - Fixed a multipart parser bug affecting mostly file uploads.
+ - Fixed input tag helper escaping. (vti)
+ - Fixed url_for WebSocket support.
+ - Fixed url_for format handling.
+
0.999929 2010-08-17 00:00:00
- Removed OS X resource fork files.
@@ -107,7 +219,7 @@ This file documents the revision history for Perl extension Mojolicious.
Mojo::Message.
- Added EXPERIMENTAL idle_cb attribute to Mojo::IOLoop.
- Added more perlish block syntax to Mojo::Template.
- - Added non blocking TLS handshake support to Mojo::IOLoop.
+ - Added non-blocking TLS handshake support to Mojo::IOLoop.
- Added proxy support to Mojo::Client.
- Added the ability to have dispatch plugins.
- Added "under" to Mojolicious::Lite.
@@ -1,6 +1,5 @@
.perltidyrc
Changes
-examples/.DS_Store
examples/connect-proxy.pl
examples/flash-policy-server.pl
examples/microhttpd.pl
@@ -14,12 +13,7 @@ lib/Mojo/Client.pm
lib/Mojo/Command.pm
lib/Mojo/Command/Cgi.pm
lib/Mojo/Command/Daemon.pm
-lib/Mojo/Command/DaemonPrefork.pm
lib/Mojo/Command/Fastcgi.pm
-lib/Mojo/Command/Generate.pm
-lib/Mojo/Command/Generate/App.pm
-lib/Mojo/Command/Generate/Gitignore.pm
-lib/Mojo/Command/Generate/Makefile.pm
lib/Mojo/Command/Get.pm
lib/Mojo/Command/Psgi.pm
lib/Mojo/Command/Test.pm
@@ -35,8 +29,6 @@ lib/Mojo/CookieJar.pm
lib/Mojo/Date.pm
lib/Mojo/DOM.pm
lib/Mojo/Exception.pm
-lib/Mojo/Filter.pm
-lib/Mojo/Filter/Chunked.pm
lib/Mojo/Headers.pm
lib/Mojo/HelloWorld.pm
lib/Mojo/Home.pm
@@ -52,20 +44,20 @@ lib/Mojo/Path.pm
lib/Mojo/Server.pm
lib/Mojo/Server/CGI.pm
lib/Mojo/Server/Daemon.pm
-lib/Mojo/Server/Daemon/Prefork.pm
lib/Mojo/Server/FastCGI.pm
lib/Mojo/Server/PSGI.pm
lib/Mojo/Template.pm
lib/Mojo/Transaction.pm
lib/Mojo/Transaction/HTTP.pm
-lib/Mojo/Transaction/Single.pm
lib/Mojo/Transaction/WebSocket.pm
lib/Mojo/Upload.pm
lib/Mojo/URL.pm
lib/Mojolicious.pm
lib/Mojolicious/Command/Generate.pm
lib/Mojolicious/Command/Generate/App.pm
+lib/Mojolicious/Command/Generate/Gitignore.pm
lib/Mojolicious/Command/Generate/LiteApp.pm
+lib/Mojolicious/Command/Generate/Makefile.pm
lib/Mojolicious/Command/Inflate.pm
lib/Mojolicious/Command/Routes.pm
lib/Mojolicious/Commands.pm
@@ -105,14 +97,12 @@ lib/MojoX/Session/Cookie/Controller.pm
lib/MojoX/Types.pm
lib/ojo.pm
lib/Test/Mojo.pm
-lib/Test/Mojo/Server.pm
LICENSE
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
-README.md
+README.pod
script/mojo
-script/mojolicious
t/mojo/apache_cgi.t
t/mojo/apache_fastcgi.t
t/mojo/app.t
@@ -125,8 +115,6 @@ t/mojo/client_online.t
t/mojo/content.t
t/mojo/cookie.t
t/mojo/cookiejar.t
-t/mojo/daemon.t
-t/mojo/daemon_prefork.t
t/mojo/date.t
t/mojo/dom.t
t/mojo/fastcgi.t
@@ -152,18 +140,27 @@ t/mojolicious/app.t
t/mojolicious/charset_lite_app.t
t/mojolicious/dispatcher_lite_app.t
t/mojolicious/embedded_lite_app.t
+t/mojolicious/external_lite_app.json
+t/mojolicious/external_lite_app.pl
+t/mojolicious/external_lite_app.t
t/mojolicious/i18n_lite_app.t
t/mojolicious/json_config_lite_app.json
t/mojolicious/json_config_lite_app.t
+t/mojolicious/json_config_mode_lite_app.json
+t/mojolicious/json_config_mode_lite_app.t
+t/mojolicious/json_config_mode_lite_app.testing.json
t/mojolicious/lib/EmbeddedTestApp.pm
t/mojolicious/lib/MojoliciousTest.pm
t/mojolicious/lib/MojoliciousTest/Foo.pm
t/mojolicious/lib/MojoliciousTest/Foo/Bar.pm
+t/mojolicious/lib/MojoliciousTest/Plugin/TestPlugin.pm
t/mojolicious/lib/MojoliciousTest/SyntaxError.pm
t/mojolicious/lib/MojoliciousTest2/Foo.pm
t/mojolicious/lib/MojoliciousTestController.pm
+t/mojolicious/lib/PluginWithTemplate.pm
t/mojolicious/lib/SingleFileTestApp.pm
t/mojolicious/lite_app.t
+t/mojolicious/longpolling_lite_app.t
t/mojolicious/pod_renderer_lite_app.t
t/mojolicious/production_app.t
t/mojolicious/public/hello.txt
@@ -188,11 +185,10 @@ t/mojolicious/upload_lite_app.t
t/mojolicious/websocket_lite_app.t
t/mojolicious/websocket_proxy_lite_app.t
t/mojolicious/websocket_tls_proxy_lite_app.t
-t/mojox/dispatcher/routes.t
-t/mojox/dispatcher/routes/controller.t
+t/mojox/dispatcher.t
+t/mojox/pattern.t
t/mojox/renderer.t
-t/mojox/routes/pattern.t
-t/mojox/routes/routes.t
+t/mojox/routes.t
t/pod.t
t/pod_coverage.t
META.yml Module meta-data (added by MakeMaker)
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Mojolicious
-version: 0.999929
+version: 0.999933
abstract: The Web In A Box!
author:
- Sebastian Riedel <sri@cpan.org>
@@ -41,6 +41,7 @@ requires:
Test::More: 0
Time::HiRes: 0
resources:
+ bugtracker: http://github.com/kraih/mojo/issues
homepage: http://mojolicious.org
license: http://dev.perl.org/licenses/
MailingList: http://groups.google.com/group/mojolicious
@@ -30,7 +30,8 @@ WriteMakefile(
license => 'http://dev.perl.org/licenses/',
MailingList =>
'http://groups.google.com/group/mojolicious',
- repository => 'http://github.com/kraih/mojo'
+ repository => 'http://github.com/kraih/mojo',
+ bugtracker => 'http://github.com/kraih/mojo/issues'
},
no_index => {directory => [qw/t/]}
},
@@ -41,7 +42,7 @@ WriteMakefile(
)
),
- EXE_FILES => ['script/mojo', 'script/mojolicious'],
+ EXE_FILES => ['script/mojo'],
PREREQ_PM => {
'Carp' => 0,
'Cwd' => 0,
@@ -74,5 +75,5 @@ WriteMakefile(
'Test::More' => 0,
'Time::HiRes' => 0
},
- test => {TESTS => 't/*.t t/*/*.t t/*/*/*.t t/*/*/*/*.t'}
+ test => {TESTS => 't/*.t t/*/*.t'}
);
@@ -1,107 +0,0 @@
-Back in the early days of the web there was this wonderful Perl library
-called CGI, many people only learned Perl because of it.
-It was simple enough to get started without knowing much about the language
-and powerful enough to keep you going, learning by doing was much fun.
-While most of the techniques used are outdated now, the idea behind it is
-not.
-Mojolicious is a new attempt at implementing this idea using state of the art
-technology.
-
-Features
---------
-
-* An amazing MVC web framework supporting a simplified single file mode
- through Mojolicious::Lite.
-
- Powerful out of the box with RESTful routes, plugins, Perl-ish templates,
- session management, signed cookies, testing framework, static file server,
- I18N, first class unicode support and much more for you to discover.
-
-* Very clean, portable and Object Oriented pure Perl API without any hidden
- magic and no requirements besides Perl 5.8.7.
-
-* Full stack HTTP 1.1 and WebSocket client/server implementation with IPv6,
- TLS, Bonjour, IDNA, chunking and multipart support.
-
-* Builtin async IO and prefork web server supporting epoll, kqueue, hot
- deployment and UNIX domain socket sharing, perfect for embedding.
-
-* Automatic CGI, FastCGI and PSGI detection.
-
-* JSON and XML/HTML5 parser with CSS3 selector support.
-
-* Fresh code based upon years of experience developing Catalyst.
-
-Duct Tape For The HTML5 Web
----------------------------
-
-Web development for humans, making hard things possible and everything fun.
-
- use Mojolicious::Lite;
-
- get '/hello' => sub { shift->render(text => 'Hello World!') }
-
- get '/time' => 'clock';
-
- websocket '/echo' => sub {
- my $self = shift;
- $self->receive_message(
- sub {
- my ($self, $message) = @_;
- $self->send_message("echo: $message");
- }
- );
- };
-
- get '/title' => sub {
- my $self = shift;
- my $url = $self->param('url');
- $self->render(text =>
- $self->client->get($url)->res->dom->at('title')->text);
- };
-
- post '/:offset' => sub {
- my $self = shift;
- my $offset = $self->param('offset') || 23;
- $self->render(json => {list => [0 .. $offset]});
- };
-
- app->start;
- __DATA__
-
- @@ clock.html.ep
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
-
-For more user friendly documentation see "perldoc Mojolicious::Guides"
-and "perldoc Mojolicious::Lite".
-
-Have Some Cake
---------------
-
- .---------------------------------------------------------------.
- | Fun! |
- '---------------------------------------------------------------'
- .---------------------------------------------------------------.
- | |
- | .----------------------------------------------'
- | | .--------------------------------------------.
- | Application | | Mojolicious::Lite |
- | | '--------------------------------------------'
- | | .--------------------------------------------.
- | | | Mojolicious |
- '----------------' '--------------------------------------------'
- .---------------------------------------------------------------.
- | Mojo |
- '---------------------------------------------------------------'
- .-------. .-----------. .--------. .------------. .-------------.
- | CGI | | FastCGI | | PSGI | | HTTP 1.1 | | WebSocket |
- '-------' '-----------' '--------' '------------' '-------------'
-
-Installation
-------------
-
- perl Makefile.PL
- make
- make test
- make install
@@ -0,0 +1,131 @@
+
+=pod
+
+Back in the early days of the web there was this wonderful Perl library
+called L<CGI>, many people only learned Perl because of it.
+It was simple enough to get started without knowing much about the language
+and powerful enough to keep you going, learning by doing was much fun.
+While most of the techniques used are outdated now, the idea behind it is
+not.
+L<Mojolicious> is a new attempt at implementing this idea using state of the
+art technology.
+
+=head2 Features
+
+=over 4
+
+=item *
+
+An amazing MVC web framework supporting a simplified single file mode through
+L<Mojolicious::Lite>.
+
+=over 4
+
+Powerful out of the box with RESTful routes, plugins, Perl-ish templates,
+session management, signed cookies, testing framework, static file server,
+I18N, first class unicode support and much more for you to discover.
+
+=back
+
+=item *
+
+Very clean, portable and Object Oriented pure Perl API without any hidden
+magic and no requirements besides Perl 5.8.7.
+
+=item *
+
+Full stack HTTP 1.1 and WebSocket client/server implementation with IPv6,
+TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
+
+=item *
+
+Builtin async IO web server supporting epoll, kqueue, UNIX domain sockets and
+hot deployment, perfect for embedding.
+
+=item *
+
+Automatic CGI, FastCGI and L<PSGI> detection.
+
+=item *
+
+JSON and XML/HTML5 parser with CSS3 selector support.
+
+=item *
+
+Fresh code based upon years of experience developing L<Catalyst>.
+
+=back
+
+=head2 Duct Tape For The HTML5 Web
+
+Web development for humans, making hard things possible and everything fun.
+
+ use Mojolicious::Lite;
+
+ get '/hello' => sub { shift->render(text => 'Hello World!') }
+
+ get '/time' => 'clock';
+
+ websocket '/echo' => sub {
+ my $self = shift;
+ $self->on_message(
+ sub {
+ my ($self, $message) = @_;
+ $self->send_message("echo: $message");
+ }
+ );
+ };
+
+ get '/title' => sub {
+ my $self = shift;
+ my $url = $self->param('url');
+ $self->render(text =>
+ $self->client->get($url)->res->dom->at('title')->text);
+ };
+
+ post '/:offset' => sub {
+ my $self = shift;
+ my $offset = $self->param('offset') || 23;
+ $self->render(json => {list => [0 .. $offset]});
+ };
+
+ app->start;
+ __DATA__
+
+ @@ clock.html.ep
+ % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ <%= link_to clock => begin %>
+ The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ <% end %>
+
+For more user friendly documentation see L<Mojolicious::Guides> and
+L<Mojolicious::Lite>.
+
+=head2 Have Some Cake
+
+Loosely coupled building blocks, use what you like and just ignore the rest.
+
+ .---------------------------------------------------------------.
+ | Fun! |
+ '---------------------------------------------------------------'
+ .---------------------------------------------------------------.
+ | |
+ | .----------------------------------------------'
+ | | .--------------------------------------------.
+ | Application | | Mojolicious::Lite |
+ | | '--------------------------------------------'
+ | | .--------------------------------------------.
+ | | | Mojolicious |
+ '----------------' '--------------------------------------------'
+ .---------------------------------------------------------------.
+ | Mojo |
+ '---------------------------------------------------------------'
+ .-------. .-----------. .--------. .------------. .-------------.
+ | CGI | | FastCGI | | PSGI | | HTTP 1.1 | | WebSocket |
+ '-------' '-----------' '--------' '------------' '-------------'
+
+=head2 Installation
+
+ curl -L cpanmin.us | perl - http://latest.mojolicio.us
+
+=cut
diff --git a/var/tmp/source/KRAIH/Mojolicious-0.999929/Mojolicious-0.999929/examples/.DS_Store b/var/tmp/source/KRAIH/Mojolicious-0.999929/Mojolicious-0.999929/examples/.DS_Store
deleted file mode 100644
index 5008ddfc..00000000
Binary files a/var/tmp/source/KRAIH/Mojolicious-0.999929/Mojolicious-0.999929/examples/.DS_Store and /dev/null differ
@@ -20,7 +20,7 @@ my $c = {};
# Minimal connect proxy server to test TLS tunneling
$loop->listen(
port => 3000,
- read_cb => sub {
+ on_read => sub {
my ($loop, $client, $chunk) = @_;
if (my $server = $c->{$client}->{connection}) {
return $loop->write($server, $chunk);
@@ -35,7 +35,7 @@ $loop->listen(
my $server = $loop->connect(
address => $address,
port => $port,
- connect_cb => sub {
+ on_connect => sub {
my ($loop, $server) = @_;
print "Forwarding to $address:$port.\n";
$c->{$client}->{connection} = $server;
@@ -43,11 +43,11 @@ $loop->listen(
"HTTP/1.1 200 OK\x0d\x0a"
. "Connection: keep-alive\x0d\x0a\x0d\x0a");
},
- read_cb => sub {
+ on_read => sub {
my ($loop, $server, $chunk) = @_;
$loop->write($client, $chunk);
},
- error_cb => sub {
+ on_error => sub {
shift->drop($client);
delete $c->{$client};
}
@@ -56,7 +56,7 @@ $loop->listen(
else { $loop->drop($client) }
}
},
- error_cb => sub {
+ on_error => sub {
my ($self, $client) = @_;
shift->drop($c->{$client}->{connection})
if $c->{$client}->{connection};
@@ -31,7 +31,7 @@ EOF
# Flash policy server
$loop->listen(
port => 843,
- read_cb => sub {
+ on_read => sub {
my ($loop, $id) = @_;
# Write XML
@@ -20,13 +20,13 @@ my $buffer = {};
# Minimal ioloop example demonstrating how to cheat at HTTP benchmarks :)
$loop->listen(
port => 3000,
- accept_cb => sub {
+ on_accept => sub {
my ($loop, $id) = @_;
# Initialize buffer
$buffer->{$id} = '';
},
- read_cb => sub {
+ on_read => sub {
my ($loop, $id, $chunk) = @_;
# Append chunk to buffer
@@ -41,11 +41,10 @@ $loop->listen(
# Write a minimal HTTP response
# (not spec compliant but benchmarks won't care)
$loop->write($id => "HTTP/1.1 200 OK\x0d\x0a"
- . "Connection: keep-alive\x0d\x0aContent-Length: 11\x0d\x0a"
- . "\x0d\x0aHello Mojo!");
+ . "Connection: keep-alive\x0d\x0a\x0d\x0a");
}
},
- error_cb => sub {
+ on_error => sub {
my ($self, $id) = @_;
# Clean buffer
@@ -25,12 +25,13 @@ use constant PUNYCODE_INITIAL_N => 128;
# Core module since Perl 5.9.3
use constant SHA1 => eval 'use Digest::SHA (); 1';
-__PACKAGE__->attr(raw_size => 0);
-
# Punycode delimiter
my $DELIMITER = chr 0x2D;
-# XHTML 1.0 entities for html_unescape
+# Encode cache
+my %ENCODE;
+
+# XHTML 1.0 entities for html_unescape (without "apos")
my %ENTITIES = (
Aacute => 193,
aacute => 225,
@@ -47,7 +48,7 @@ my %ENTITIES = (
amp => 38,
and => 8743,
ang => 8736,
- apos => 39,
+ '#39' => 39,
Aring => 197,
aring => 229,
asymp => 8776,
@@ -290,6 +291,9 @@ my %ENTITIES = (
# Reverse entities for html_escape
my %REVERSE_ENTITIES = reverse %ENTITIES;
+# "apos"
+$ENTITIES{apos} = 39;
+
# Unreserved character map for url_sanitize
my %UNRESERVED;
{
@@ -307,7 +311,11 @@ my %UNRESERVED;
sub import {
my $caller = caller;
no strict 'refs';
- *{"${caller}::b"} = sub { Mojo::ByteStream->new(@_) }
+ *{"${caller}::b"} = sub {
+ bless {
+ bytestream => @_ < 2 ? defined $_[0] ? "$_[0]" : '' : join('', @_)
+ }, 'Mojo::ByteStream';
+ }
if @_ > 1;
}
@@ -315,8 +323,8 @@ sub import {
# Well, I think the veal died of loneliness.
sub new {
my $self = shift->SUPER::new();
- $self->{bytestream} = @_ < 2 ? defined $_[0] ? $_[0] : '' : join('', @_);
- $self->{raw_size} = length $self->{bytestream};
+ $self->{bytestream} =
+ @_ < 2 ? defined $_[0] ? "$_[0]" : '' : join('', @_);
return $self;
}
@@ -327,7 +335,7 @@ sub add_chunk {
return $self unless defined $chunk;
# Raw length
- $self->{raw_size} = $self->{raw_size} + length $chunk;
+ $self->{_raw_size} += length $chunk;
# Store
$self->{bytestream} .= $chunk;
@@ -410,6 +418,7 @@ sub decamelize {
# Number 1: "Cover for me."
# Number 2: "Oh, good idea, Boss!"
# Number 3: "It was like that when I got here."
+
sub decode {
my ($self, $encoding) = @_;
@@ -418,8 +427,18 @@ sub decode {
# Try decoding
eval {
- $self->{bytestream} =
- Encode::decode($encoding, $self->{bytestream}, 1);
+
+ # UTF-8
+ if ($encoding eq 'UTF-8') {
+ die unless utf8::decode $self->{bytestream};
+ }
+
+ # Everything else
+ else {
+ $self->{bytestream} =
+ ($ENCODE{$encoding} ||= Encode::find_encoding($encoding))
+ ->decode($self->{bytestream}, 1);
+ }
};
# Failed
@@ -444,7 +463,15 @@ sub encode {
# Shortcut
return $self unless $encoding;
- $self->{bytestream} = Encode::encode($encoding, $self->{bytestream});
+ # UTF-8
+ if ($encoding eq 'UTF-8') { utf8::encode $self->{bytestream} }
+
+ # Everything else
+ else {
+ $self->{bytestream} =
+ ($ENCODE{$encoding} ||= Encode::find_encoding($encoding))
+ ->encode($self->{bytestream});
+ }
return $self;
}
@@ -691,6 +718,8 @@ sub quote {
return $self;
}
+sub raw_size { shift->{_raw_size} || 0 }
+
sub remove {
my ($self, $length, $chunk) = @_;
@@ -760,6 +789,7 @@ sub url_escape {
# Escape
utf8::encode $self->{bytestream} if utf8::is_utf8 $self->{bytestream};
+ return $self unless $self->{bytestream} =~ /[^$pattern]/;
$self->{bytestream} =~ s/([^$pattern])/sprintf('%%%02X',ord($1))/ge;
return $self;
@@ -777,6 +807,9 @@ sub url_sanitize {
sub url_unescape {
my $self = shift;
+ # Shortcut
+ return $self if index($self->{bytestream}, '%') == -1;
+
# Unescape
$self->{bytestream} =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge;
@@ -792,7 +825,7 @@ sub xml_escape {
s/</</g;
s/>/>/g;
s/"/"/g;
- s/'/'/g;
+ s/'/'/g;
}
return $self;
@@ -937,17 +970,6 @@ Mojo::ByteStream - ByteStream
L<Mojo::ByteStream> provides portable text and bytestream manipulation
functions.
-=head1 ATTRIBUTES
-
-L<Mojo::ByteStream> implements the following attributes.
-
-=head2 C<raw_size>
-
- my $size = $stream->raw_size;
- $stream = $stream->raw_size(23);
-
-Raw bytestream size in bytes.
-
=head1 METHODS
L<Mojo::ByteStream> inherits all methods from L<Mojo::Base> and implements
@@ -1102,6 +1124,12 @@ Quoted Printable encode bytestream.
Quote bytestream.
+=head2 C<raw_size>
+
+ my $size = $stream->raw_size;
+
+Raw size of chunks added to bytestream in bytes.
+
=head2 C<remove>
my $chunk = $stream->remove(4);
@@ -25,16 +25,21 @@ use Scalar::Util 'weaken';
use constant DEBUG => $ENV{MOJO_CLIENT_DEBUG} || 0;
# You can't let a single bad experience scare you away from drugs.
-__PACKAGE__->attr(
- [qw/app http_proxy https_proxy tls_ca_file tls_verify_cb tx/]);
+__PACKAGE__->attr([qw/app http_proxy https_proxy tx/]);
__PACKAGE__->attr(cookie_jar => sub { Mojo::CookieJar->new });
__PACKAGE__->attr(ioloop => sub { Mojo::IOLoop->new });
-__PACKAGE__->attr(keep_alive_timeout => 15);
-__PACKAGE__->attr(log => sub { Mojo::Log->new });
-__PACKAGE__->attr(max_keep_alive_connections => 5);
+__PACKAGE__->attr(keep_alive_timeout => 15);
+__PACKAGE__->attr(log => sub { Mojo::Log->new });
+__PACKAGE__->attr(max_connections => 5);
__PACKAGE__->attr(max_redirects => sub { $ENV{MOJO_MAX_REDIRECTS} || 0 });
__PACKAGE__->attr(websocket_timeout => 300);
+# DEPRECATED in Comet!
+*finished = \&on_finish;
+*max_keep_alive_connections = \&max_connections;
+*process = \&start;
+*receive_message = \&on_message;
+
# Singleton
our $CLIENT;
@@ -305,10 +310,8 @@ sub clone {
$clone->log($self->log);
$clone->cookie_jar($self->cookie_jar);
$clone->keep_alive_timeout($self->keep_alive_timeout);
- $clone->max_keep_alive_connections($self->max_keep_alive_connections);
+ $clone->max_connections($self->max_connections);
$clone->max_redirects($self->max_redirects);
- $clone->tls_ca_file($self->tls_ca_file);
- $clone->tls_verify_cb($self->tls_verify_cb);
$clone->websocket_timeout($self->websocket_timeout);
return $clone;
@@ -318,7 +321,7 @@ sub clone {
# and you didn't do it.
sub delete {
my $self = shift;
- return $self->_tx_queue_or_process($self->build_tx('DELETE', @_));
+ return $self->_tx_queue_or_start($self->build_tx('DELETE', @_));
}
sub detect_proxy {
@@ -341,7 +344,18 @@ sub finish {
$tx->finish;
}
-sub finished {
+# "What are you lookin' at?" - the innocent words of a drunken child.
+sub get {
+ my $self = shift;
+ return $self->_tx_queue_or_start($self->build_tx('GET', @_));
+}
+
+sub head {
+ my $self = shift;
+ return $self->_tx_queue_or_start($self->build_tx('HEAD', @_));
+}
+
+sub on_finish {
my $self = shift;
# Transaction
@@ -358,66 +372,44 @@ sub finished {
weaken $tx;
# Connection finished
- $tx->finished(sub { shift; local $self->{tx} = $tx; $self->$cb(@_) });
+ $tx->on_finish(sub { shift; local $self->{tx} = $tx; $self->$cb(@_) });
}
-# "What are you lookin' at?" - the innocent words of a drunken child.
-sub get {
+sub on_message {
my $self = shift;
- return $self->_tx_queue_or_process($self->build_tx('GET', @_));
-}
-sub head {
- my $self = shift;
- return $self->_tx_queue_or_process($self->build_tx('HEAD', @_));
+ # Transaction
+ my $tx = $self->tx;
+
+ # WebSocket
+ croak 'Transaction is not a WebSocket' unless $tx->is_websocket;
+
+ # Callback
+ my $cb = shift;
+
+ # Weaken
+ weaken $self;
+ weaken $tx;
+
+ # Receive
+ $tx->on_message(sub { shift; local $self->{tx} = $tx; $self->$cb(@_) });
+
+ return $self;
}
sub post {
my $self = shift;
- return $self->_tx_queue_or_process($self->build_tx('POST', @_));
+ return $self->_tx_queue_or_start($self->build_tx('POST', @_));
}
sub post_form {
my $self = shift;
- return $self->_tx_queue_or_process($self->build_form_tx(@_));
-}
-
-# Olive oil? Asparagus? If your mother wasn't so fancy,
-# we could just shop at the gas station like normal people.
-sub process {
- my $self = shift;
-
- # Queue
- $self->queue(@_) if @_;
- my $queue = delete $self->{_queue} || [];
-
- # Process sync subrequests in new client
- if (!$self->{_is_async} && $self->{_processing}) {
- my $clone = $self->clone;
- $clone->queue(@$_) for @$queue;
- return $clone->process;
- }
-
- # Add async transactions from queue
- else { $self->_tx_start(@$_) for @$queue }
-
- # Process sync requests
- if (!$self->{_is_async} && $self->{_processing}) {
-
- # Start loop
- my $loop = $self->ioloop;
- $loop->start;
-
- # Cleanup
- $loop->one_tick(0);
- }
-
- return $self;
+ return $self->_tx_queue_or_start($self->build_form_tx(@_));
}
sub put {
my $self = shift;
- $self->_tx_queue_or_process($self->build_tx('PUT', @_));
+ $self->_tx_queue_or_start($self->build_tx('PUT', @_));
}
# And I gave that man directions, even though I didn't know the way,
@@ -435,29 +427,6 @@ sub queue {
return $self;
}
-sub receive_message {
- my $self = shift;
-
- # Transaction
- my $tx = $self->tx;
-
- # WebSocket
- croak 'Transaction is not a WebSocket' unless $tx->is_websocket;
-
- # Callback
- my $cb = shift;
-
- # Weaken
- weaken $self;
- weaken $tx;
-
- # Receive
- $tx->receive_message(
- sub { shift; local $self->{tx} = $tx; $self->$cb(@_) });
-
- return $self;
-}
-
sub req { shift->tx->req(@_) }
sub res { shift->tx->res(@_) }
@@ -480,6 +449,39 @@ sub send_message {
return $self;
}
+# Olive oil? Asparagus? If your mother wasn't so fancy,
+# we could just shop at the gas station like normal people.
+sub start {
+ my $self = shift;
+
+ # Queue
+ $self->queue(@_) if @_;
+ my $queue = delete $self->{_queue} || [];
+
+ # Process sync subrequests in new client
+ if (!$self->{_is_async} && $self->{_processing}) {
+ my $clone = $self->clone;
+ $clone->queue(@$_) for @$queue;
+ return $clone->start;
+ }
+
+ # Add async transactions from queue
+ else { $self->_tx_start(@$_) for @$queue }
+
+ # Process sync requests
+ if (!$self->{_is_async} && $self->{_processing}) {
+
+ # Start loop
+ my $loop = $self->ioloop;
+ $loop->start;
+
+ # Cleanup
+ $loop->one_tick(0);
+ }
+
+ return $self;
+}
+
# It's like my dad always said: eventually, everybody gets shot.
sub test_server {
my $self = shift;
@@ -526,7 +528,7 @@ sub _cache {
if ($id) {
# Limit keep alive connections
- my $max = $self->max_keep_alive_connections;
+ my $max = $self->max_connections;
while (@$cache > $max) {
my $cached = shift @$cache;
$self->_drop($cached->[1]);
@@ -538,17 +540,29 @@ sub _cache {
return $self;
}
+ # Loop
+ my $loop = $self->ioloop;
+
# Dequeue
my $result;
my @cache;
for my $cached (@$cache) {
# Search for name or id
- $result = $cached->[1] and next
- if $cached->[1] eq $name || $cached->[0] eq $name;
+ if (!$result && ($cached->[1] eq $name || $cached->[0] eq $name)) {
+
+ # Result
+ my $id = $cached->[1];
+
+ # Test connection
+ if ($loop->test($id)) { $result = $id }
+
+ # Drop corrupted connection
+ else { $loop->drop($id) }
+ }
# Cache again
- push @cache, $cached;
+ else { push @cache, $cached }
}
$self->{_cache} = \@cache;
@@ -608,12 +622,10 @@ sub _connect {
port => $port,
socket => $id,
tls => $scheme eq 'https' ? 1 : 0,
- tls_ca_file => $self->tls_ca_file || $ENV{MOJO_CA_FILE},
- tls_verify_cb => $self->tls_verify_cb,
- connect_cb => sub { $self->_connected($_[1]) },
- error_cb => sub { $self->_error(@_) },
- hup_cb => sub { $self->_hup(@_) },
- read_cb => sub { $self->_read(@_) }
+ on_connect => sub { $self->_connected($_[1]) },
+ on_error => sub { $self->_error(@_) },
+ on_hup => sub { $self->_hup(@_) },
+ on_read => sub { $self->_read(@_) }
);
# Error
@@ -671,11 +683,7 @@ sub _connect_proxy {
return unless my $oid = $tx->connection;
# Start TLS
- my $nid = $self->ioloop->start_tls(
- $oid,
- tls_ca_file => $self->tls_ca_file || $ENV{MOJO_CA_FILE},
- tls_verify_cb => $self->tls_verify_cb
- );
+ my $nid = $self->ioloop->start_tls($oid);
# Cleanup
$old->req->proxy(undef);
@@ -868,9 +876,17 @@ sub _redirect {
# Location
return unless my $location = $res->headers->location;
+ $location = Mojo::URL->new($location);
+
+ # Request
+ my $req = $old->req;
+
+ # Fix broken location without authority
+ $location->authority($req->url->authority)
+ unless $location->authority;
# Method
- my $method = $old->req->method;
+ my $method = $req->method;
$method = 'GET' unless $method =~ /^GET|HEAD$/i;
# Max redirects
@@ -880,13 +896,11 @@ sub _redirect {
# New transaction
my $new = Mojo::Transaction::HTTP->new;
- my $req = $new->req;
- $req->method($method);
- $req->url->parse($location);
+ $new->req->method($method)->url($location);
$new->previous($old);
# Start redirected request
- my $nid = $self->_tx_start($new, $c->{cb});
+ return 1 unless my $nid = $self->_tx_start($new, $c->{cb});
# Create new connection
$self->{_cs}->{$nid}->{redirects} = $r + 1;
@@ -940,11 +954,11 @@ sub _tx_info {
return ($scheme, $host, $port);
}
-sub _tx_queue_or_process {
+sub _tx_queue_or_start {
my ($self, $tx, $cb) = @_;
- # Quick process
- $self->process($tx, sub { $tx = $_[1] }) and return $tx
+ # Quick start
+ $self->start($tx, sub { $tx = $_[1] }) and return $tx
if !$cb && !$self->{_is_async};
# Queue transaction with callback
@@ -1006,7 +1020,7 @@ sub _tx_start {
weaken $self;
# Resume callback
- $tx->resume_cb(sub { $self->_write($id) });
+ $tx->on_resume(sub { $self->_write($id) });
# Counter
$self->{_processing} ||= 0;
@@ -1056,7 +1070,7 @@ sub _upgrade {
weaken $self;
# Resume callback
- $new->resume_cb(sub { $self->_write($id) });
+ $new->on_resume(sub { $self->_write($id) });
return $new;
}
@@ -1122,7 +1136,8 @@ Mojo::Client - Async IO HTTP 1.1 And WebSocket Client
# Scrape the latest headlines from a news site
my $news = 'http://digg.com';
- $client->get($news)->res->dom->find("h3 > a.offsite")->each(sub {
+ $client->max_redirects(3);
+ $client->get($news)->res->dom('h3 > a.story-title')->each(sub {
print shift->text . "\n";
});
@@ -1140,13 +1155,13 @@ Mojo::Client - Async IO HTTP 1.1 And WebSocket Client
my $callback = sub { print shift->res->body };
$client->get('http://mojolicious.org' => $callback);
$client->get('http://search.cpan.org' => $callback);
- $client->process;
+ $client->start;
# Websocket request
$client->websocket(
'ws://websockets.org:8787' => sub {
my $client = shift;
- $client->receive_message(
+ $client->on_message(
sub {
my ($client, $message) = @_;
print "$message\n";
@@ -1155,14 +1170,14 @@ Mojo::Client - Async IO HTTP 1.1 And WebSocket Client
);
$client->send_message('hi there!');
}
- )->process;
+ )->start;
=head1 DESCRIPTION
L<Mojo::Client> is a full featured async io HTTP 1.1 and WebSocket client
with C<IPv6>, C<TLS>, C<epoll> and C<kqueue> support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::INET6> and
+Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
L<IO::Socket::SSL> are supported transparently and used if installed.
=head1 ATTRIBUTES
@@ -1222,10 +1237,10 @@ Timeout in seconds for keep alive between requests, defaults to C<15>.
A L<Mojo::Log> object used for logging, by default the application log will
be used.
-=head2 C<max_keep_alive_connections>
+=head2 C<max_connections>
- my $max_keep_alive_connections = $client->max_keep_alive_connections;
- $client = $client->max_keep_alive_connections(5);
+ my $max_connections = $client->max_connections;
+ $client = $client->max_connections(5);
Maximum number of keep alive connections that the client will retain before
it starts closing the oldest cached ones, defaults to C<5>.
@@ -1238,29 +1253,12 @@ it starts closing the oldest cached ones, defaults to C<5>.
Maximum number of redirects the client will follow before it fails, defaults
to C<0>.
-=head2 C<tls_ca_file>
-
- my $tls_ca_file = $client->tls_ca_file;
- $client = $client->tls_ca_file('/etc/tls/cacerts.pem');
-
-TLS certificate authority file to use, defaults to the C<MOJO_CA_FILE>
-environment variable.
-Note that L<IO::Socket::SSL> must be installed for HTTPS support.
-
-=head2 C<tls_verify_cb>
-
- my $tls_verify_cb = $client->tls_verify_cb;
- $client = $client->tls_verify_cb(sub {...});
-
-Callback to verify your TLS connection, by default the client will accept
-most certificates.
-Note that L<IO::Socket::SSL> must be installed for HTTPS support.
-
=head2 C<tx>
$client->tx;
-The last finished transaction, only available from callbacks.
+The last finished transaction, only available from callbacks, usually a
+L<Mojo::Transaction::HTTP> or L<Mojo::Transaction::WebSocket> object.
=head2 C<websocket_timeout>
@@ -1323,11 +1321,11 @@ you can quickly run out of file descriptors with too many active clients.
{myzip => {file => $asset, filename => 'foo.zip'}}
);
-Versatile transaction builder for forms.
+Versatile L<Mojo::Transaction::HTTP> builder for forms.
my $tx = $client->build_form_tx('http://kraih.com/foo' => {test => 123});
$tx->res->body(sub { print $_[1] });
- $client->process($tx);
+ $client->start($tx);
=head2 C<build_tx>
@@ -1340,23 +1338,25 @@ Versatile transaction builder for forms.
POST => 'http://kraih.com' => {Connection => 'close'} => 'Hi!'
);
-Versatile general purpose transaction builder.
+Versatile general purpose L<Mojo::Transaction::HTTP> builder.
# Streaming response
my $tx = $client->build_tx(GET => 'http://mojolicious.org');
$tx->res->body(sub { print $_[1] });
- $client->process($tx);
+ $client->start($tx);
# Custom socket
my $tx = $client->build_tx(GET => 'http://mojolicious.org');
$tx->connection($socket);
- $client->process($tx);
+ $client->start($tx);
=head2 C<build_websocket_tx>
my $tx = $client->build_websocket_tx('ws://localhost:3000');
-WebSocket transaction builder.
+Versatile L<Mojo::Transaction::HTTP> builder for WebSocket handshakes.
+An upgrade to L<Mojo::Transaction::WebSocket> will happen automatically after
+a successful handshake is performed.
=head2 C<clone>
@@ -1381,7 +1381,16 @@ you can quickly run out of file descriptors with too many active clients.
'http://kraih.com' => {Connection => 'close'} => 'Hi!' => sub {...}
);
-Send a HTTP C<DELETE> request.
+Prepare HTTP C<DELETE> request.
+
+ $client->delete('http://kraih.com' => sub {
+ print shift->res->body;
+ })->start;
+
+The request will be performed right away and the resulting
+L<Mojo::Transaction::HTTP> object returned if no callback is given.
+
+ print $client->delete('http://kraih.com')->res->body;
=head2 C<detect_proxy>
@@ -1395,17 +1404,6 @@ Check environment variables for proxy information.
Finish the WebSocket connection, only available from callbacks.
-=head2 C<finished>
-
- $client->finished(sub {...});
-
-Callback signaling that peer finished the WebSocket connection, only
-available from callbacks.
-
- $client->finished(sub {
- my $client = shift;
- });
-
=head2 C<get>
my $tx = $client->get('http://kraih.com');
@@ -1421,7 +1419,16 @@ available from callbacks.
'http://kraih.com' => {Connection => 'close'} => 'Hi!' => sub {...}
);
-Send a HTTP C<GET> request.
+Prepare HTTP C<GET> request.
+
+ $client->get('http://kraih.com' => sub {
+ print shift->res->body;
+ })->start;
+
+The request will be performed right away and the resulting
+L<Mojo::Transaction::HTTP> object returned if no callback is given.
+
+ print $client->get('http://kraih.com')->res->body;
=head2 C<head>
@@ -1438,7 +1445,37 @@ Send a HTTP C<GET> request.
'http://kraih.com' => {Connection => 'close'} => 'Hi!' => sub {...}
);
-Send a HTTP C<HEAD> request.
+Prepare HTTP C<HEAD> request.
+
+ $client->head('http://kraih.com' => sub {
+ print shift->res->headers->content_length;
+ })->start;
+
+The request will be performed right away and the resulting
+L<Mojo::Transaction::HTTP> object returned if no callback is given.
+
+ print $client->head('http://kraih.com')->res->headers->content_length;
+
+=head2 C<on_finish>
+
+ $client->on_finish(sub {...});
+
+Callback signaling that peer finished the WebSocket connection, only
+available from callbacks.
+
+ $client->on_finish(sub {
+ my $client = shift;
+ });
+
+=head2 C<on_message>
+
+ $client = $client->on_message(sub {...});
+
+Receive messages via WebSocket, only available from callbacks.
+
+ $client->on_message(sub {
+ my ($client, $message) = @_;
+ });
=head2 C<post>
@@ -1461,7 +1498,16 @@ Send a HTTP C<HEAD> request.
'http://kraih.com' => {Connection => 'close'} => 'Hi!' => sub {...}
);
-Send a HTTP C<POST> request.
+Prepare HTTP C<POST> request.
+
+ $client->post('http://kraih.com' => sub {
+ print shift->res->body;
+ })->start;
+
+The request will be performed right away and the resulting
+L<Mojo::Transaction::HTTP> object returned if no callback is given.
+
+ print $client->post('http://kraih.com')->res->body;
=head2 C<post_form>
@@ -1530,17 +1576,16 @@ Send a HTTP C<POST> request.
sub {...}
);
-Send a HTTP C<POST> request with form data.
+Prepare HTTP C<POST> request with form data.
-=head2 C<process>
+ $client->post_form('http://kraih.com' => {q => 'test'} => sub {
+ print shift->res->body;
+ })->start;
- $client = $client->process;
- $client = $client->process(@transactions);
- $client = $client->process(@transactions => sub {...});
+The request will be performed right away and the resulting
+L<Mojo::Transaction::HTTP> object returned if no callback is given.
-Process all queued transactions.
-Will be blocking unless you have a global shared ioloop and use the C<async>
-method.
+ print $client->post_form('http://kraih.com' => {q => 'test'})->res->body;
=head2 C<put>
@@ -1557,7 +1602,16 @@ method.
'http://kraih.com' => {Connection => 'close'} => 'Hi!' => sub {...}
);
-Send a HTTP C<PUT> request.
+Prepare HTTP C<PUT> request.
+
+ $client->put('http://kraih.com' => sub {
+ print shift->res->body;
+ })->start;
+
+The request will be performed right away and the resulting
+L<Mojo::Transaction::HTTP> object returned if no callback is given.
+
+ print $client->put('http://kraih.com')->res->body;
=head2 C<queue>
@@ -1566,29 +1620,19 @@ Send a HTTP C<PUT> request.
Queue a list of transactions for processing.
-=head2 C<receive_message>
-
- $client = $client->receive_message(sub {...});
-
-Receive messages via WebSocket, only available from callbacks.
-
- $client->receive_message(sub {
- my ($client, $message) = @_;
- });
-
=head2 C<req>
my $req = $client->req;
The request object of the last finished transaction, only available from
-callbacks.
+callbacks, usually a L<Mojo::Message::Request> object.
=head2 C<res>
my $res = $client->res;
The response object of the last finished transaction, only available from
-callbacks.
+callbacks, usually a L<Mojo::Message::Response> object.
=head2 C<singleton>
@@ -1603,6 +1647,16 @@ everywhere inside the process.
Send a message via WebSocket, only available from callbacks.
+=head2 C<start>
+
+ $client = $client->start;
+ $client = $client->start(@transactions);
+ $client = $client->start(@transactions => sub {...});
+
+Start processing all queued transactions.
+Will be blocking unless you have a global shared ioloop and use the C<async>
+method.
+
=head2 C<test_server>
my $port = $client->test_server;
@@ -10,13 +10,13 @@ use Mojo::Server::CGI;
use Getopt::Long 'GetOptions';
__PACKAGE__->attr(description => <<'EOF');
-Start application with CGI backend.
+Start application with CGI.
EOF
__PACKAGE__->attr(usage => <<"EOF");
usage: $0 cgi [OPTIONS]
These options are available:
- --nph Enable non-parsed-header mode.
+ --nph Enable non-parsed-header mode.
EOF
# Hi, Super Nintendo Chalmers!
@@ -10,32 +10,27 @@ use Mojo::Server::Daemon;
use Getopt::Long 'GetOptions';
__PACKAGE__->attr(description => <<'EOF');
-Start application with HTTP 1.1 backend.
+Start application with HTTP 1.1 and WebSocket server.
EOF
__PACKAGE__->attr(usage => <<"EOF");
usage: $0 daemon [OPTIONS]
These options are available:
- --clients <number> Set maximum number of concurrent clients,
- defaults to 1000.
- --group <name> Set group name for process.
- --keepalive <seconds> Set keep-alive timeout, defaults to 15.
- --keepaliverequests <number> Set maximum number of requests per
- keep-alive connection, defaults to 100.
- --listen <locations> Set a comma separated list of locations you
- want to listen on, defaults to
- http://*:3000.
- --pid <path> Set path to pid file, defaults to a random
- temporary file.
- --queue <size> Set listen queue size, defaults to
- SOMAXCONN.
- --reload Automatically reload application when the
- source code changes.
- --requests <number> Set the maximum number of requests the
- daemon is allowed to handle, not used by
- default.
- --user <name> Set user name for process.
- --websocket <seconds> Set WebSocket timeout, defaults to 300.
+ --clients <number> Set maximum number of concurrent clients, defaults
+ to 1000.
+ --group <name> Set group name for process.
+ --keepalive <seconds> Set keep-alive timeout, defaults to 15.
+ --listen <locations> Set a comma separated list of locations you want to
+ listen on, defaults to http://*:3000.
+ --queue <size> Set listen queue size, defaults to SOMAXCONN.
+ --reload Automatically reload application when the source
+ code changes.
+ --requests <number> Set maximum number of requests per keep-alive
+ connection, defaults to 100.
+ --reverseproxy Activate reverse proxy support, defaults to the
+ value of MOJO_REVERSE_PROXY.
+ --user <name> Set user name for process.
+ --websocket <seconds> Set WebSocket timeout, defaults to 300.
EOF
@@ -48,18 +43,16 @@ sub run {
# Options
local @ARGV = @_ if @_;
GetOptions(
- 'clients=i' => sub { $daemon->max_clients($_[1]) },
- 'group=s' => sub { $daemon->group($_[1]) },
- 'keepalive=i' => sub { $daemon->keep_alive_timeout($_[1]) },
- 'keepaliverequests=i' =>
- sub { $daemon->max_keep_alive_requests($_[1]) },
- 'listen=s' => sub { $daemon->listen($_[1]) },
- 'pid=s' => sub { $daemon->pid_file($_[1]) },
- 'queue=i' => sub { $daemon->listen_queue_size($_[1]) },
- reload => sub { $daemon->reload(1) },
- 'requests=i' => sub { $daemon->max_requests($_[1]) },
- 'user=s' => sub { $daemon->user($_[1]) },
- 'websocket=i' => sub { $daemon->websocket_timeout($_[1]) }
+ 'clients=i' => sub { $daemon->max_clients($_[1]) },
+ 'group=s' => sub { $daemon->group($_[1]) },
+ 'keepalive=i' => sub { $daemon->keep_alive_timeout($_[1]) },
+ 'listen=s' => sub { $daemon->listen($_[1]) },
+ 'queue=i' => sub { $daemon->listen_queue_size($_[1]) },
+ reload => sub { $ENV{MOJO_RELOAD} = 1 },
+ 'requests=i' => sub { $daemon->max_requests($_[1]) },
+ 'reverseproxy' => sub { $ENV{MOJO_REVERSE_PROXY} = 1 },
+ 'user=s' => sub { $daemon->user($_[1]) },
+ 'websocket=i' => sub { $daemon->websocket_timeout($_[1]) }
);
# Run
@@ -1,150 +0,0 @@
-package Mojo::Command::DaemonPrefork;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-use Mojo::Server::Daemon::Prefork;
-
-use Getopt::Long 'GetOptions';
-
-__PACKAGE__->attr(description => <<'EOF');
-Start application with preforking HTTP 1.1 backend.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 daemon_prefork [OPTIONS]
-
-These options are available:
- --clients <number> Set maximum number of concurrent clients per
- child, defaults to 1.
- --daemonize Daemonize parent.
- --group <name> Set group name for children.
- --idle <seconds> Set time children can be idle without
- getting killed, defaults to 30.
- --interval <seconds> Set interval for process maintainance,
- defaults to 15.
- --keepalive <seconds> Set keep-alive timeout, defaults to 15.
- --keepaliverequests <number> Set maximum number of requests per
- keep-alive connection, defaults to 100.
- --listen <locations> Set a comma separated list of locations you
- want to listen on, defaults to http://*:3000.
- --lock <path> Set path to lock file, defaults to a random
- temporary file.
- --maxspare <number> Set maximum amount of idle children,
- defaults to 10.
- --minspare <number> Set minimum amount of idle children,
- defaults to 5.
- --pid <path> Set path to pid file, defaults to a random
- temporary file.
- --queue <size> Set listen queue size, defaults to
- SOMAXCONN.
- --reload Automatically reload application when the
- source code changes.
- --requests <number> Set maximum number of requests a worker
- process is allowed to handle, defaults to
- 1000.
- --servers <number> Set maximum number of children, defaults to
- 100.
- --start <number> Set number of children to spawn at startup,
- defaults to 5.
- --user <name> Set user name for children.
- --websocket <seconds> Set WebSocket timeout, defaults to 300.
-EOF
-
-# Dear Mr. President, there are too many states nowadays.
-# Please eliminate three.
-# P.S. I am not a crackpot.
-sub run {
- my $self = shift;
- my $daemon = Mojo::Server::Daemon::Prefork->new;
-
- # Options
- my $daemonize;
- local @ARGV = @_ if @_;
- GetOptions(
- 'clients=i' => sub { $daemon->max_clients($_[1]) },
- daemonize => \$daemonize,
- 'group=s' => sub { $daemon->group($_[1]) },
- 'idle=i' => sub { $daemon->idle_timeout($_[1]) },
- 'interval=i' => sub { $daemon->cleanup_interval($_[1]) },
- 'keepalive=i' => sub { $daemon->keep_alive_timeout($_[1]) },
- 'keepaliverequests=i' =>
- sub { $daemon->max_keep_alive_requests($_[1]) },
- 'listen=s' => sub { $daemon->listen($_[1]) },
- 'lock=s' => sub { $daemon->lock_file($_[1]) },
- 'maxspare=i' => sub { $daemon->max_spare_servers($_[1]) },
- 'minspare=i' => sub { $daemon->min_spare_servers($_[1]) },
- 'pid=s' => sub { $daemon->pid_file($_[1]) },
- 'queue=i' => sub { $daemon->listen_queue_size($_[1]) },
- reload => sub { $daemon->reload(1) },
- 'requests=i' => sub { $daemon->max_requests($_[1]) },
- 'servers=i' => sub { $daemon->max_servers($_[1]) },
- 'start=i' => sub { $daemon->start_servers($_[1]) },
- 'user=s' => sub { $daemon->user($_[1]) },
- 'websocket=i' => sub { $daemon->websocket_timeout($_[1]) }
- );
-
- # Daemonize
- $daemon->daemonize if $daemonize;
-
- # Run
- $daemon->run;
-
- return $self;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::DaemonPrefork - Prefork Daemon Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Daemon::Prefork;
-
- my $daemon = Mojo::Command::Daemon::Prefork->new;
- $daemon->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Daemon::Prefork> is a command interface to
-L<Mojo::Server::Daemon::Prefork>.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Daemon::Prefork> inherits all attributes from
-L<Mojo::Command> and implements the following new ones.
-
-=head2 C<description>
-
- my $description = $daemon->description;
- $daemon = $daemon->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $daemon->usage;
- $daemon = $daemon->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Daemon::Prefork> inherits all methods from L<Mojo::Command>
-and implements the following new ones.
-
-=head2 C<run>
-
- $daemon = $daemon->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -8,7 +8,7 @@ use base 'Mojo::Command';
use Mojo::Server::FastCGI;
__PACKAGE__->attr(description => <<'EOF');
-Start application with FastCGI backend.
+Start application with FastCGI.
EOF
__PACKAGE__->attr(usage => <<"EOF");
usage: $0 fastcgi
@@ -1,146 +0,0 @@
-package Mojo::Command::Generate::App;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-__PACKAGE__->attr(description => <<'EOF');
-Generate application directory structure.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 generate app [NAME]
-EOF
-
-# Okay folks, show's over. Nothing to see here, show's... Oh my god!
-# A horrible plane crash! Hey everybody, get a load of this flaming wreckage!
-# Come on, crowd around, crowd around!
-sub run {
- my ($self, $class) = @_;
- $class ||= 'MyMojoApp';
-
- my $name = $self->class_to_file($class);
-
- # Script
- $self->render_to_rel_file('mojo', "$name/script/$name", $class);
- $self->chmod_file("$name/script/$name", 0744);
-
- # Appclass
- my $path = $self->class_to_path($class);
- $self->render_to_rel_file('appclass', "$name/lib/$path", $class);
-
- # Test
- $self->render_to_rel_file('test', "$name/t/basic.t", $class);
-
- # Log
- $self->create_rel_dir("$name/log");
-}
-
-1;
-__DATA__
-@@ mojo
-% my $class = shift;
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use File::Basename 'dirname';
-use File::Spec;
-
-use lib join '/', File::Spec->splitdir(dirname(__FILE__)), 'lib';
-use lib join '/', File::Spec->splitdir(dirname(__FILE__)), '..', 'lib';
-
-# Check if Mojo is installed
-eval 'use Mojo::Commands';
-die <<EOF if $@;
-It looks like you don't have the Mojo Framework installed.
-Please visit http://mojolicious.org for detailed installation instructions.
-
-EOF
-
-# Application
-$ENV{MOJO_APP} ||= '<%= $class %>';
-
-# Start commands
-Mojo::Commands->start;
-@@ appclass
-% my $class = shift;
-package <%= $class %>;
-
-use strict;
-use warnings;
-
-use base 'Mojo';
-
-sub handler {
- my ($self, $tx) = @_;
-
- # Hello world!
- $tx->res->code(200);
- $tx->res->headers->content_type('text/plain');
- $tx->res->body('Hello Mojo!');
-}
-
-1;
-@@ test
-% my $class = shift;
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 1;
-
-use_ok('<%= $class %>');
-__END__
-=head1 NAME
-
-Mojo::Command::Generate::App - Application Generator Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Generate::App;
-
- my $app = Mojo::Command::Generate::App->new;
- $app->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Generate::App> is an application generator.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Generate::App> inherits all attributes from
-L<Mojo::Command> and implements the following new ones.
-
-=head2 C<description>
-
- my $description = $app->description;
- $app = $app->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $app->usage;
- $app = $app->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Generate::App> inherits all methods from L<Mojo::Command>
-and implements the following new ones.
-
-=head2 C<run>
-
- $app = $app->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,89 +0,0 @@
-package Mojo::Command::Generate::Gitignore;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-__PACKAGE__->attr(description => <<'EOF');
-Generate .gitignore.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 generate gitignore
-EOF
-
-# I want to see the edge of the universe.
-# Ooh, that sounds cool.
-# It's funny, you live in the universe, but you never get to do this things
-# until someone comes to visit.
-sub run {
- my $self = shift;
- $self->render_to_rel_file('gitignore', '.gitignore');
- $self->chmod_file('.gitignore', 0644);
-}
-
-1;
-__DATA__
-@@ gitignore
-.*
-!.gitignore
-!.perltidyrc
-*~
-blib
-Makefile*
-!Makefile.PL
-META.yml
-MANIFEST*
-!MANIFEST.SKIP
-pm_to_blib
-__END__
-=head1 NAME
-
-Mojo::Command::Generate::Gitignore - Gitignore Generator Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Generate::Gitignore;
-
- my $gitignore = Mojo::Command::Generate::Gitignore->new;
- $gitignore->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Generate::Gitignore> is a C<.gitignore> generator.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Generate::Gitignore> inherits all attributes from
-L<Mojo::Command> and implements the following new ones.
-
-=head2 C<description>
-
- my $description = $gitignore->description;
- $gitignore = $gitignore->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $gitignore->usage;
- $gitignore = $gitignore->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Generate::Gitignore> inherits all methods from
-L<Mojo::Command> and implements the following new ones.
-
-=head2 C<run>
-
- $gitignore = $gitignore->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,102 +0,0 @@
-package Mojo::Command::Generate::Makefile;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Command';
-
-__PACKAGE__->attr(description => <<'EOF');
-Generate Makefile.PL.
-EOF
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 generate makefile
-EOF
-
-# You don’t like your job, you don’t strike.
-# You go in every day and do it really half-assed. That’s the American way.
-sub run {
- my $self = shift;
-
- my $class = $ENV{MOJO_APP} || 'MyApp';
- my $path = $self->class_to_path($class);
- my $name = $self->class_to_file($class);
-
- $self->render_to_rel_file('makefile', 'Makefile.PL', $class, $path,
- $name);
- $self->chmod_file('Makefile.PL', 0744);
-}
-
-1;
-__DATA__
-@@ makefile
-% my ($class, $path, $name) = @_;
-#!/usr/bin/env perl
-
-use 5.008001;
-
-use strict;
-use warnings;
-
-# Son, when you participate in sporting events,
-# it's not whether you win or lose, it's how drunk you get.
-use ExtUtils::MakeMaker;
-
-WriteMakefile(
- NAME => '<%= $class %>',
- VERSION_FROM => 'lib/<%= $path %>',
- AUTHOR => 'A Good Programmer <nospam@cpan.org>',
- EXE_FILES => ['script/<%= $name %>'],
- PREREQ_PM => { 'Mojo' => '0.9003' },
- test => {TESTS => 't/*.t t/*/*.t t/*/*/*.t'}
-);
-__END__
-=head1 NAME
-
-Mojo::Command::Generate::Makefile - Makefile Generator Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Generate::Makefile;
-
- my $makefile = Mojo::Command::Generate::Makefile->new;
- $makefile->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Generate::Makefile> is a makefile generator.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Generate::Makefile> inherits all attributes from
-L<Mojo::Command> and implements the following new ones.
-
-=head2 C<description>
-
- my $description = $makefile->description;
- $makefile = $makefile->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<usage>
-
- my $usage = $makefile->usage;
- $makefile = $makefile->usage('Foo!');
-
-Usage information for this command, used for the help screen.
-
-=head1 METHODS
-
-L<Mojo::Command::Generate::Makefile> inherits all methods from
-L<Mojo::Command> and implements the following new ones.
-
-=head2 C<run>
-
- $makefile = $makefile->run(@ARGV);
-
-Run this command.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,88 +0,0 @@
-package Mojo::Command::Generate;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Commands';
-
-__PACKAGE__->attr(description => <<'EOF');
-Generate files and directories from templates.
-EOF
-__PACKAGE__->attr(hint => <<"EOF");
-
-See '$0 generate help GENERATOR' for more information on a specific generator.
-EOF
-__PACKAGE__->attr(message => <<"EOF");
-usage: $0 generate GENERATOR [OPTIONS]
-
-These generators are currently available:
-EOF
-__PACKAGE__->attr(namespaces => sub { ['Mojo::Command::Generate'] });
-__PACKAGE__->attr(usage => <<"EOF");
-usage: $0 generate GENERATOR [OPTIONS]
-EOF
-
-# If The Flintstones has taught us anything,
-# it's that pelicans can be used to mix cement.
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Command::Generate - Generator Command
-
-=head1 SYNOPSIS
-
- use Mojo::Command::Generate;
-
- my $generator = Mojo::Command::Generate->new;
- $generator->run(@ARGV);
-
-=head1 DESCRIPTION
-
-L<Mojo::Command::Generate> lists available generators.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Command::Generate> inherits all attributes from L<Mojo::Commands> and
-implements the following new ones.
-
-=head2 C<description>
-
- my $description = $generator->description;
- $generator = $generator->description('Foo!');
-
-Short description of this command, used for the command list.
-
-=head2 C<hint>
-
- my $hint = $generator->hint;
- $generator = $generator->hint('Foo!');
-
-Short hint shown after listing available generator commands.
-
-=head2 C<message>
-
- my $message = $generator->message;
- $generator = $generator->message('Bar!');
-
-Short usage message shown before listing available generator commands.
-
-=head2 C<namespaces>
-
- my $namespaces = $generator->namespaces;
- $generator = $generator->namespaces(['Mojo::Command::Generate']);
-
-Namespaces to search for available generator commands, defaults to
-L<Mojo::Command::Generate>.
-
-=head1 METHODS
-
-L<Mojo::Command::Generate> inherits all methods from L<Mojo::Commands>.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -7,6 +7,7 @@ use base 'Mojo::Command';
use Mojo::ByteStream 'b';
use Mojo::Client;
+use Mojo::IOLoop;
use Mojo::Transaction::HTTP;
use Getopt::Long 'GetOptions';
@@ -36,7 +37,7 @@ sub run {
$url = b($url)->decode('UTF-8')->to_string;
# Client
- my $client = Mojo::Client->new;
+ my $client = Mojo::Client->new(ioloop => Mojo::IOLoop->singleton);
# Silence
$client->log->level('fatal');
@@ -58,7 +59,7 @@ sub run {
);
# Request
- $client->process($tx);
+ $client->start($tx);
# Error
my ($message, $code) = $tx->error;
@@ -11,7 +11,7 @@ use Mojo::Server::PSGI;
# People die all the time, just like that.
# Why, you could wake up dead tomorrow! Well, good night.
__PACKAGE__->attr(description => <<'EOF');
-Start application with PSGI backend.
+Start application with PSGI.
EOF
__PACKAGE__->attr(usage => <<"EOF");
usage: $0 psgi
@@ -22,6 +22,9 @@ sub run {
my $self = shift;
my $psgi = Mojo::Server::PSGI->new;
+ # Preload
+ $psgi->app;
+
# Return app callback
return sub { $psgi->run(@_) };
}
@@ -10,6 +10,9 @@ use FindBin;
use File::Spec;
use Test::Harness;
+# Okay folks, show's over. Nothing to see here, show's... Oh my god!
+# A horrible plane crash! Hey everybody, get a load of this flaming wreckage!
+# Come on, crowd around, crowd around!
__PACKAGE__->attr(description => <<'EOF');
Run unit tests.
EOF
@@ -5,6 +5,7 @@ use warnings;
use base 'Mojo::Command';
+use Mojo::Client;
use Mojo::IOLoop;
use Mojo::Server::Daemon;
use Mojolicious;
@@ -25,6 +26,21 @@ sub run {
my $mojo = $Mojolicious::VERSION;
my $codename = $Mojolicious::CODENAME;
+ # Latest version
+ my $latest = $mojo;
+ eval {
+ Mojo::Client->new->max_redirects(3)
+ ->get('search.cpan.org/dist/Mojolicious')->res->dom('.version')
+ ->each(sub { $latest = $_->text if $_->text =~ /^[\d\.]+$/ });
+ };
+
+ # Message
+ my $message = 'This version is up to date, have fun!';
+ $message = 'Thanks for testing a development release, you are awesome!'
+ if $latest < $mojo;
+ $message = "You might want to update your Mojolicious to $latest."
+ if $latest > $mojo;
+
# Epoll
my $epoll = Mojo::IOLoop::EPOLL() ? $IO::Epoll::VERSION : 'not installed';
@@ -34,7 +50,7 @@ sub run {
# IPv6
my $ipv6 =
- Mojo::IOLoop::IPV6() ? $IO::Socket::INET6::VERSION : 'not installed';
+ Mojo::IOLoop::IPV6() ? $IO::Socket::IP::VERSION : 'not installed';
# TLS
my $tls =
@@ -48,15 +64,17 @@ sub run {
print <<"EOF";
CORE
- Perl ($])
+ Perl ($], $^O)
Mojolicious ($mojo, $codename)
OPTIONAL
IO::Epoll ($epoll)
IO::KQueue ($kqueue)
- IO::Socket::INET6 ($ipv6)
+ IO::Socket::IP ($ipv6)
IO::Socket::SSL ($tls)
Net::Rendezvous::Publish ($bonjour)
+
+$message
EOF
return $self;
@@ -136,6 +136,8 @@ sub get_data {
return $all->{$data};
}
+# You don’t like your job, you don’t strike.
+# You go in every day and do it really half-assed. That’s the American way.
sub help {
my $self = shift;
print $self->usage;
@@ -24,11 +24,34 @@ __PACKAGE__->attr(namespaces => sub { ['Mojo::Command'] });
# Aren't we forgetting the true meaning of Christmas?
# You know, the birth of Santa.
+sub detect {
+ my ($self, $guess) = @_;
+
+ # Hypnotoad
+ return 'hypnotoad' if defined $ENV{HYPNOTOAD_APP};
+
+ # PSGI (Plack only for now)
+ return 'psgi' if defined $ENV{PLACK_ENV};
+
+ # CGI
+ return 'cgi'
+ if defined $ENV{PATH_INFO} || defined $ENV{GATEWAY_INTERFACE};
+
+ # No further detection if we have a guess
+ return $guess if $guess;
+
+ # FastCGI (detect absence of WINDIR for Windows and USER for UNIX)
+ return 'fastcgi' if !defined $ENV{WINDIR} && !defined $ENV{USER};
+
+ # Nothing
+ return;
+}
+
sub run {
my ($self, $name, @args) = @_;
# Try to detect environment
- $name = $self->_detect($name) unless $ENV{MOJO_NO_DETECT};
+ $name = $self->detect($name) unless $ENV{MOJO_NO_DETECT};
# Run command
if ($name && $name =~ /^\w+$/ && ($name ne 'help' || $args[0])) {
@@ -71,6 +94,9 @@ sub run {
return $help ? $command->help : $command->run(@args);
}
+ # Test
+ return $self if $ENV{HARNESS_ACTIVE};
+
# Try all namespaces
my $commands = [];
my $seen = {};
@@ -139,26 +165,6 @@ sub start {
return ref $self ? $self->run(@args) : $self->new->run(@args);
}
-sub _detect {
- my ($self, $name) = @_;
-
- # PSGI (Plack only for now)
- return 'psgi' if defined $ENV{PLACK_ENV};
-
- # CGI
- return 'cgi'
- if defined $ENV{PATH_INFO} || defined $ENV{GATEWAY_INTERFACE};
-
- # No further detection if we have a name
- return $name if $name;
-
- # FastCGI
- return 'fastcgi' unless defined $ENV{PATH};
-
- # Nothing
- return;
-}
-
1;
__END__
@@ -197,36 +203,6 @@ List available commands with short descriptions.
List available options for the command with short descriptions.
-=item C<generate>
-
- mojo generate
- mojo generate help
-
-List available generator commands with short descriptions.
-
- mojo generate help <generator>
-
-List available options for generator command with short descriptions.
-
-=item C<generate app>
-
- mojo generate app <AppName>
-
-Generate application directory structure for a fully functional L<Mojo>
-application.
-
-=item C<generate makefile>
-
- script/myapp generate makefile
-
-Generate C<Makefile.PL> file for application.
-
-=item C<generate psgi>
-
- script/myapp generate psgi
-
-Generate C<myapp.psgi> file for application.
-
=item C<cgi>
mojo cgi
@@ -241,13 +217,6 @@ Start application with CGI backend.
Start application with standalone HTTP 1.1 server backend.
-=item C<daemon_prefork>
-
- mojo daemon_prefork
- script/myapp daemon_prefork
-
-Start application with preforking standalone HTTP 1.1 server backend.
-
=item C<fastcgi>
mojo fastcgi
@@ -310,6 +279,13 @@ Namespaces to search for available commands, defaults to L<Mojo::Command>.
L<Mojo::Commands> inherits all methods from L<Mojo::Command> and implements
the following new ones.
+=head2 C<detect>
+
+ my $env = $commands->detect;
+ my $env = $commands->detect($guess);
+
+Try to detect environment.
+
=head2 C<run>
$commands->run;
@@ -90,7 +90,7 @@ sub get_body_chunk {
my ($self, $offset) = @_;
# Body generator
- return $self->generate_body_chunk($offset) if $self->body_cb;
+ return $self->generate_body_chunk($offset) if $self->on_read;
# Multipart
my $boundary = $self->build_boundary;
@@ -134,15 +134,14 @@ sub get_body_chunk {
sub parse {
my $self = shift;
- # Parse headers and filter body
+ # Parse headers and chunked body
$self->SUPER::parse(@_);
# Custom body parser
- return $self if $self->body_cb;
+ return $self if $self->on_read;
# Upgrade state
- $self->{_state} = 'multipart_preamble'
- if ($self->{_state} || '') eq 'body';
+ $self->{_multi_state} ||= 'multipart_preamble';
# Parse multipart content
$self->_parse_multipart;
@@ -168,17 +167,17 @@ sub _parse_multipart {
last if $self->is_done;
# Preamble
- if (($self->{_state} || '') eq 'multipart_preamble') {
+ if (($self->{_multi_state} || '') eq 'multipart_preamble') {
last unless $self->_parse_multipart_preamble($boundary);
}
# Boundary
- elsif (($self->{_state} || '') eq 'multipart_boundary') {
+ elsif (($self->{_multi_state} || '') eq 'multipart_boundary') {
last unless $self->_parse_multipart_boundary($boundary);
}
# Body
- elsif (($self->{_state} || '') eq 'multipart_body') {
+ elsif (($self->{_multi_state} || '') eq 'multipart_body') {
last unless $self->_parse_multipart_body($boundary);
}
}
@@ -203,7 +202,7 @@ sub _parse_multipart_body {
# Store chunk
my $chunk = $buffer->remove($pos);
$self->parts->[-1] = $self->parts->[-1]->parse($chunk);
- $self->{_state} = 'multipart_boundary';
+ $self->{_multi_state} = 'multipart_boundary';
return 1;
}
@@ -217,7 +216,7 @@ sub _parse_multipart_boundary {
# New part
push @{$self->parts}, Mojo::Content::Single->new(relaxed => 1);
- $self->{_state} = 'multipart_body';
+ $self->{_multi_state} = 'multipart_body';
return 1;
}
@@ -227,7 +226,7 @@ sub _parse_multipart_boundary {
$buffer->remove(length $end);
# Done
- $self->{_state} = 'done';
+ $self->{_state} = $self->{_multi_state} = 'done';
}
return;
@@ -243,7 +242,7 @@ sub _parse_multipart_preamble {
$buffer->remove($pos, "\x0d\x0a");
# Parse boundary
- $self->{_state} = 'multipart_boundary';
+ $self->{_multi_state} = 'multipart_boundary';
return 1;
}
@@ -21,13 +21,17 @@ sub body_contains {
return 0;
}
-sub body_size { shift->asset->size }
+sub body_size {
+ my $self = shift;
+ return ($self->headers->content_length || 0) if $self->on_read;
+ return $self->asset->size;
+}
sub get_body_chunk {
my ($self, $offset) = @_;
# Body generator
- return $self->generate_body_chunk($offset) if $self->body_cb;
+ return $self->generate_body_chunk($offset) if $self->on_read;
# Normal content
return $self->asset->get_chunk($offset);
@@ -36,11 +40,11 @@ sub get_body_chunk {
sub parse {
my $self = shift;
- # Parse headers and filter body
+ # Parse headers and chunked body
$self->SUPER::parse(@_);
# Still parsing headers or using a custom body parser
- return $self if ($self->{_state} || '') eq 'headers' || $self->body_cb;
+ return $self if ($self->{_state} || '') eq 'headers' || $self->on_read;
# Headers
my $headers = $self->headers;
@@ -88,7 +92,7 @@ sub parse {
$asset->add_chunk($self->buffer->remove($need)) if $need > 0;
# Done
- $self->{_state} = 'done' if $length <= $self->raw_body_size;
+ $self->{_state} = 'done' if $length <= $self->progress;
}
return $self;
@@ -6,18 +6,18 @@ use warnings;
use base 'Mojo::Base';
use Carp 'croak';
-use Mojo::ByteStream;
-use Mojo::Filter::Chunked;
+use Mojo::ByteStream 'b';
use Mojo::Headers;
use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 262144;
-__PACKAGE__->attr([qw/body_cb filter/]);
-__PACKAGE__->attr([qw/buffer filter_buffer/] => sub { Mojo::ByteStream->new }
-);
+__PACKAGE__->attr([qw/auto_relax relaxed/] => 0);
+__PACKAGE__->attr([qw/buffer chunked_buffer/] => sub { b() });
__PACKAGE__->attr(headers => sub { Mojo::Headers->new });
-__PACKAGE__->attr(raw_header_size => 0);
-__PACKAGE__->attr(relaxed => 0);
+__PACKAGE__->attr('on_read');
+
+# DEPRECATED in Comet!
+*read_cb = \&on_read;
sub body_contains {
croak 'Method "body_contains" not implemented by subclass';
@@ -70,34 +70,26 @@ sub build_headers {
return $headers;
}
+sub finish { shift->{_eof} = 1 }
+
sub generate_body_chunk {
my ($self, $offset) = @_;
- # Shortcut
- return '' unless $self->body_cb;
-
- # Remove written
+ # Buffer
my $buffer = $self->buffer;
- my $written = $offset - ($buffer->raw_size - $buffer->size);
- $buffer->remove($written);
-
- # Fill buffer
- if (!$self->{_eof} && $buffer->size < CHUNK_SIZE) {
-
- # Generate
- my $chunk = $self->body_cb->($self, $buffer->raw_size);
- # EOF
- if (defined $chunk && !length $chunk) { $self->{_eof} = 1 }
+ # Delay
+ my $delay = delete $self->{_delay};
- # Buffer chunk
- else { $buffer->add_chunk($chunk) }
+ # Callback
+ if (!$delay && !$buffer->size && (my $cb = delete $self->{_drain})) {
+ $self->$cb($offset);
}
# Get chunk
- my $chunk = $buffer->to_string;
+ my $chunk = $buffer->empty;
- # Pause or EOF
+ # EOF
return $self->{_eof} ? '' : undef unless length $chunk;
return $chunk;
@@ -119,7 +111,7 @@ sub has_leftovers {
my $self = shift;
# Leftovers
- return 1 if $self->buffer->size || $self->filter_buffer->size;
+ return 1 if $self->buffer->size || $self->chunked_buffer->size;
# Empty buffer
return;
@@ -156,9 +148,9 @@ sub is_parsing_body {
sub leftovers {
my $self = shift;
- # Chunked leftovers are in the filter buffer, and so are those from a
+ # Chunked leftovers are in the chunked buffer, and so are those from a
# HEAD request
- return $self->filter_buffer->to_string if $self->filter_buffer->size;
+ return $self->chunked_buffer->to_string if $self->chunked_buffer->size;
# Normal leftovers
return $self->buffer->to_string;
@@ -168,8 +160,8 @@ sub parse {
my ($self, $chunk) = @_;
# Buffer
- my $fbuffer = $self->filter_buffer;
- $fbuffer->add_chunk($chunk);
+ my $buffer = $self->chunked_buffer;
+ $buffer->add_chunk($chunk);
# Parse headers
$self->parse_until_body;
@@ -177,28 +169,25 @@ sub parse {
# Still parsing headers
return $self if $self->{_state} eq 'headers';
- # Chunked, need to filter
- if ($self->is_chunked && ($self->{_state} || '') ne 'headers') {
+ # Relaxed parsing for broken web servers
+ if ($self->auto_relax) {
+ my $headers = $self->headers;
+ $self->relaxed(1)
+ if !defined $headers->content_length
+ && ($headers->connection || '') =~ /close/i;
+ }
- # Initialize filter
- $self->filter(
- Mojo::Filter::Chunked->new(
- headers => $self->headers,
- input_buffer => $fbuffer,
- output_buffer => $self->buffer
- )
- ) unless $self->filter;
-
- # Filter
- $self->filter->parse;
- $self->{_state} = 'done' if $self->filter->is_done;
+ # Chunked
+ if ($self->is_chunked && ($self->{_state} || '') ne 'headers') {
+ $self->_parse_chunked;
+ $self->{_state} = 'done' if ($self->{_chunked} || '') eq 'done';
}
# Not chunked, pass through
- else { $self->buffer($fbuffer) }
+ else { $self->buffer($buffer) }
# Custom body parser
- if (my $cb = $self->body_cb) {
+ if (my $cb = $self->on_read) {
# Chunked or relaxed content
if ($self->is_chunked || $self->relaxed) {
@@ -221,7 +210,7 @@ sub parse {
}
# Done
- $self->{_state} = 'done' if $length <= $self->raw_body_size;
+ $self->{_state} = 'done' if $length <= $self->progress;
}
}
@@ -241,21 +230,21 @@ sub parse_body_once {
return $self;
}
+# Quick Smithers. Bring the mind eraser device!
+# You mean the revolver, sir?
+# Precisely.
sub parse_until_body {
my ($self, $chunk) = @_;
# Buffer
- my $fbuffer = $self->filter_buffer;
- $fbuffer->add_chunk($chunk);
+ my $buffer = $self->chunked_buffer;
+ $buffer->add_chunk($chunk);
# Parser started
unless ($self->{_state}) {
# Update size
- my $length = $fbuffer->size;
- my $raw_length = $fbuffer->raw_size;
- my $raw_header_length = $raw_length - $length;
- $self->raw_header_size($raw_header_length);
+ $self->{_header_size} = $buffer->raw_size - $buffer->size;
# Headers
$self->{_state} = 'headers';
@@ -267,13 +256,60 @@ sub parse_until_body {
return $self;
}
-sub raw_body_size {
+sub progress {
my $self = shift;
+ $self->chunked_buffer->raw_size - ($self->{_header_size} || 0);
+}
+
+sub write {
+ my ($self, $chunk, $cb) = @_;
+
+ # Dynamic content
+ $self->on_read(sub { });
+
+ # Buffer
+ $self->buffer->add_chunk($chunk);
+
+ # Delay
+ $self->{_delay} = 1 unless defined $chunk;
+
+ # Drain callback
+ $self->{_drain} = $cb if $cb;
+}
+
+# Here's to alcohol, the cause of—and solution to—all life's problems.
+sub write_chunk {
+ my ($self, $chunk, $cb) = @_;
+
+ # Chunked transfer encoding
+ $self->headers->transfer_encoding('chunked') unless $self->is_chunked;
+
+ # Write
+ $self->write(defined $chunk ? $self->_build_chunk($chunk) : $chunk, $cb);
- # Calculate
- my $length = $self->filter_buffer->raw_size;
- my $header_length = $self->raw_header_size;
- return $length - $header_length;
+ # Finish
+ $self->finish if defined $chunk && $chunk eq '';
+}
+
+sub _build_chunk {
+ my ($self, $chunk) = @_;
+
+ # End
+ my $formatted = '';
+ if (length $chunk == 0) { $formatted = "\x0d\x0a0\x0d\x0a\x0d\x0a" }
+
+ # Separator
+ else {
+
+ # First chunk has no leading CRLF
+ $formatted = "\x0d\x0a" if $self->{_chunks};
+ $self->{_chunks} = 1;
+
+ # Chunk
+ $formatted .= sprintf('%x', length $chunk) . "\x0d\x0a$chunk";
+ }
+
+ return $formatted;
}
sub _build_headers {
@@ -288,20 +324,93 @@ sub _build_headers {
return "$headers\x0d\x0a\x0d\x0a";
}
+sub _parse_chunked {
+ my $self = shift;
+
+ # Trailing headers
+ if (($self->{_chunked} || '') eq 'trailing_headers') {
+ $self->_parse_chunked_trailing_headers;
+ return $self;
+ }
+
+ # New chunk (ignore the chunk extension)
+ my $chunked = $self->chunked_buffer;
+ my $content = $chunked->to_string;
+ my $buffer = $self->buffer;
+ while ($content =~ /^((?:\x0d?\x0a)?([\da-fA-F]+).*\x0d?\x0a)/) {
+ my $header = $1;
+ my $length = hex($2);
+
+ # Last chunk
+ if ($length == 0) {
+ $chunked->remove(length $header);
+ $self->{_chunked} = 'trailing_headers';
+ last;
+ }
+
+ # Read chunk
+ else {
+
+ # Whole chunk
+ if (length $content >= (length($header) + $length)) {
+
+ # Remove header
+ $content =~ s/^$header//;
+ $chunked->remove(length $header);
+
+ # Remove payload
+ substr $content, 0, $length, '';
+ $buffer->add_chunk($chunked->remove($length));
+
+ # Remove newline at end of chunk
+ $content =~ s/^(\x0d?\x0a)//
+ and $chunked->remove(length $1);
+ }
+
+ # Not a whole chunk, wait for more data
+ else {last}
+ }
+ }
+
+ # Trailing headers
+ $self->_parse_chunked_trailing_headers
+ if ($self->{_chunked} || '') eq 'trailing_headers';
+}
+
+sub _parse_chunked_trailing_headers {
+ my $self = shift;
+
+ # Parse
+ my $headers = $self->headers;
+ $headers->parse;
+
+ # Done
+ if ($headers->is_done) {
+
+ # Remove Transfer-Encoding
+ my $headers = $self->headers;
+ my $encoding = $headers->transfer_encoding;
+ $encoding =~ s/,?\s*chunked//ig;
+ $encoding
+ ? $headers->transfer_encoding($encoding)
+ : $headers->remove('Transfer-Encoding');
+ $headers->content_length($self->buffer->raw_size);
+
+ $self->{_chunked} = 'done';
+ }
+}
+
sub _parse_headers {
my $self = shift;
# Parse
my $headers = $self->headers;
- $headers->buffer($self->filter_buffer);
+ $headers->buffer($self->chunked_buffer);
$headers->parse;
# Update size
- my $buffer = $headers->buffer;
- my $length = $buffer->size;
- my $raw_length = $buffer->raw_size;
- my $raw_header_length = $raw_length - $length;
- $self->raw_header_size($raw_header_length);
+ my $buffer = $headers->buffer;
+ $self->{_header_size} = $buffer->raw_size - $buffer->size;
# Done
$self->{_state} = 'body' if $headers->is_done;
@@ -327,21 +436,12 @@ in RFC 2616.
L<Mojo::Content> implements the following attributes.
-=head2 C<body_cb>
+=head2 C<auto_relax>
- my $cb = $content->body_cb;
+ my $relax = $content->auto_relax;
+ $content = $content->auto_relax(1);
- $counter = 1;
- $content = $content->body_cb(sub {
- my $self = shift;
- my $chunk = '';
- $chunk = "hello world!" if $counter == 1;
- $chunk = "hello world2!\n\n" if $counter == 2;
- $counter++;
- return $chunk;
- });
-
-Content generator callback.
+Try to detect broken web servers and turn on relaxed parsing automatically.
=head2 C<buffer>
@@ -350,19 +450,12 @@ Content generator callback.
Parser buffer.
-=head2 C<filter>
-
- my $filter = $content->filter;
- $content = $content->filter(Mojo::Filter::Chunked->new);
+=head2 C<chunked_buffer>
-Input filter.
+ my $buffer = $content->chunked_buffer;
+ $content = $content->chunked_buffer(Mojo::ByteStream->new);
-=head2 C<filter_buffer>
-
- my $filter_buffer = $content->filter_buffer;
- $content = $content->filter_buffer(Mojo::ByteStream->new);
-
-Input buffer for filtering.
+Parser buffer for chunked transfer encoding.
=head2 C<headers>
@@ -371,18 +464,26 @@ Input buffer for filtering.
The headers.
-=head2 C<relaxed>
+=head2 C<on_read>
- my $relaxed = $content->relaxed;
- $content = $content->relaxed(1);
+ my $cb = $content->on_read;
+ $content = $content->on_read(sub {...});
-Activate relaxed filtering for HTTP 0.9.
+Content parser callback.
-=head2 C<raw_header_size>
+ $content = $content->on_read(sub {
+ my ($self, $chunk) = @_;
+ print $chunk;
+ });
+
+Note that this attribute is EXPERIMENTAL and might change without warning!
- my $size = $content->raw_header_size;
+=head2 C<relaxed>
+
+ my $relaxed = $content->relaxed;
+ $content = $content->relaxed(1);
-Raw size of headers in bytes.
+Activate relaxed parsing for HTTP 0.9 and broken web servers.
=head1 METHODS
@@ -413,11 +514,18 @@ Render whole body.
Render all headers.
+=head2 C<finish>
+
+ $content->finish;
+
+Finish dynamic content generation.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<generate_body_chunk>
my $chunk = $content->generate_body_chunk(0);
-Generate content from C<body_cb>.
+Generate dynamic content.
=head2 C<get_body_chunk>
@@ -499,11 +607,30 @@ Parse body once.
Parse and stop after headers.
-=head2 C<raw_body_size>
+=head2 C<progress>
+
+ my $bytes = $content->progress;
+
+Number of bytes already received from message content.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<write>
+
+ $content->write('Hello!');
+ $content->write('Hello!', sub {...});
+
+Write dynamic content, the optional drain callback will be invoked once all
+data has been written.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<write_chunk>
- my $size = $content->raw_body_size;
+ $content->write_chunk('Hello!');
+ $content->write_chunk('Hello!', sub {...});
-Raw size of body in bytes.
+Write chunked content, the optional drain callback will be invoked once all
+data has been written.
+Note that this method is EXPERIMENTAL and might change without warning!
=head1 SEE ALSO
@@ -60,7 +60,9 @@ sub to_string {
return '' unless $self->name;
# Render
- my $cookie = $self->name . '=' . $self->value;
+ my $cookie = $self->name;
+ my $value = $self->value;
+ $cookie .= "=$value" if defined $value && length $value;
if (my $path = $self->path) { $cookie .= "; \$Path=$path" }
return $cookie;
@@ -88,8 +88,10 @@ sub to_string {
return '' unless $self->name;
# Version
- my $cookie = sprintf "%s=%s; Version=%d",
- $self->name, $self->value, ($self->version || 1);
+ my $cookie = $self->name;
+ my $value = $self->value;
+ $cookie .= "=$value" if defined $value && length $value;
+ $cookie .= sprintf "; Version=%d", ($self->version || 1);
# Domain
if (my $domain = $self->domain) { $cookie .= "; Domain=$domain" }
@@ -29,11 +29,11 @@ my $CSS_ATTR_RE = qr/
my $CSS_CLASS_RE = qr/\.((?:\\\.|[^\.])+)/;
my $CSS_ELEMENT_RE = qr/^((?:\\\.|\\\#|[^\.\#])+)/;
my $CSS_ID_RE = qr/\#((?:\\\#|[^\#])+)/;
-my $CSS_PSEUDO_CLASS_RE = qr/(?:\:(\w+)(?:\(([^\)]+)\))?)/;
+my $CSS_PSEUDO_CLASS_RE = qr/(?:\:([\w\-]+)(?:\(((?:\([^\)]+\)|[^\)])+)\))?)/;
my $CSS_TOKEN_RE = qr/
(\s*,\s*)? # Separator
- ((?:[^\[\\\:\s]|$CSS_ESCAPE_RE\s?)+)? # Element
- ((?:\:\w+(?:\([^\)]+\))?)*)? # Pseudoclass
+ ((?:[^\[\\\:\s\,]|$CSS_ESCAPE_RE\s?)+)? # Element
+ ((?:\:[\w\-]+(?:\((?:\([^\)]+\)|[^\)])+\))?)*)? # Pseudoclass
((?:\[(?:$CSS_ESCAPE_RE|\w)+(?:\W?="(?:\\"|[^"])+")?\])*)? # Attributes
(?:
\s*
@@ -45,7 +45,7 @@ my $XML_ATTR_RE = qr/
(?:\s*=\s*(?:"([^"]*)"|'([^']*)'|(\S+)))? # Value
/x;
my $XML_END_RE = qr/^\s*\/\s*(.+)\s*/;
-my $XML_START_RE = qr/(\S+)([\s\S]*)/;
+my $XML_START_RE = qr/([^\s\/]+)([\s\S]*)/;
my $XML_TOKEN_RE = qr/
([^<]*) # Text
(?:
@@ -81,6 +81,8 @@ my $XML_TOKEN_RE = qr/
)??
/xis;
+sub after { shift->_add(1, @_) }
+
sub all_text {
my $self = shift;
@@ -124,6 +126,8 @@ sub attrs {
return $tree->[2];
}
+sub before { shift->_add(0, @_) }
+
sub children {
my $self = shift;
@@ -154,25 +158,29 @@ sub find {
my $pattern = $self->_parse_css($css);
# Filter tree
- return $self->_select($self->tree, $pattern);
+ return $self->_match_tree($self->tree, $pattern);
}
-sub name {
- my ($self, $name) = @_;
+sub inner_xml {
+ my $self = shift;
# Tree
my $tree = $self->tree;
- # Root
- return if $tree->[0] eq 'root';
+ # Walk tree
+ my $result = '';
+ my $start = $tree->[0] eq 'root' ? 1 : 4;
+ for my $e (@$tree[$start .. $#$tree]) {
- # Get
- return $tree->[1] unless $name;
+ # Render
+ $result .= $self->_render($e);
+ }
- # Set
- $tree->[1] = $name;
+ # Encode
+ my $charset = $self->charset;
+ $result = b($result)->encode($charset)->to_string if $charset;
- return $self;
+ return $result;
}
sub namespace {
@@ -226,6 +234,9 @@ sub parent {
sub parse {
my ($self, $xml) = @_;
+ # Detect Perl characters
+ $self->charset(undef) if utf8::is_utf8 $xml;
+
# Parse
$self->tree($self->_parse_xml($xml));
}
@@ -240,7 +251,7 @@ sub replace {
my $tree = $self->tree;
# Root
- return $self->replace_content(
+ return $self->replace_inner(
$self->new(charset => $self->charset, tree => $new))
if $tree->[0] eq 'root';
@@ -267,7 +278,7 @@ sub replace {
return $self;
}
-sub replace_content {
+sub replace_inner {
my ($self, $new) = @_;
# Parse
@@ -341,6 +352,59 @@ sub to_xml {
return $result;
}
+sub type {
+ my ($self, $type) = @_;
+
+ # Tree
+ my $tree = $self->tree;
+
+ # Root
+ return if $tree->[0] eq 'root';
+
+ # Get
+ return $tree->[1] unless $type;
+
+ # Set
+ $tree->[1] = $type;
+
+ return $self;
+}
+
+sub _add {
+ my ($self, $offset, $new) = @_;
+
+ # Parse
+ $new = ref $new ? $new->tree : $self->_parse_xml($new);
+
+ # Tree
+ my $tree = $self->tree;
+
+ # Root
+ return $self if $tree->[0] eq 'root';
+
+ # Parent
+ my $parent = $tree->[3];
+
+ # Siblings
+ my @new;
+ for my $e (@$new[1 .. $#$new]) {
+ $e->[3] = $parent if $e->[0] eq 'tag';
+ push @new, $e;
+ }
+
+ # Find
+ my $i = $parent->[0] eq 'root' ? 1 : 4;
+ for my $e (@$parent[$i .. $#$parent]) {
+ last if $e == $tree;
+ $i++;
+ }
+
+ # Add
+ splice @$parent, $i + $offset, 0, @new;
+
+ return $self;
+}
+
# Woah! God is so in your face!
# Yeah, he's my favorite fictional character.
sub _cdata {
@@ -357,57 +421,54 @@ sub _comment {
push @$$current, ['comment', $comment];
}
-sub _compare {
- my ($self, $selector, $current) = @_;
+sub _css_equation {
+ my ($self, $equation) = @_;
+ my $num = [1, 1];
- # Selectors
- for my $c (@$selector[1 .. $#$selector]) {
- my $type = $c->[0];
+ # "even"
+ if ($equation eq 'even') { $num = [2, 2] }
- # Tag
- if ($type eq 'tag') {
- my $name = $c->[1];
+ # "odd"
+ elsif ($equation eq 'odd') { $num = [2, 1] }
- # Wildcard
- next if $name eq '*';
+ # Equation
+ elsif ($equation =~ /(?:(\-?(?:\d+)?)?n)?\+?(\-?\d+)?$/) {
+ $num->[0] = $1 || 0;
+ $num->[0] = -1 if $num->[0] eq '-';
+ $num->[1] = $2 || 0;
+ }
- # Name (ignore namespace prefix)
- next if $current->[1] =~ /\:?$name$/;
- }
+ return $num;
+}
- # Attribute
- elsif ($type eq 'attribute') {
- my $key = $c->[1];
- my $regex = $c->[2];
- my $attrs = $current->[2];
+sub _css_regex {
+ my ($self, $op, $value) = @_;
- # Find attributes (ignore namespace prefix)
- my $found = 0;
- for my $name (keys %$attrs) {
- if ($name =~ /\:?$key$/) {
- ++$found and last
- if !$regex || ($attrs->{$name} || '') =~ /$regex/;
- }
- }
- next if $found;
- }
+ # Shortcut
+ return unless $value;
- # Pseudo class
- elsif ($type eq 'pseudoclass') {
- my $class = $c->[1];
+ # Quote
+ $value = quotemeta $self->_css_unescape($value);
- # ":root"
- if ($class eq 'root') {
- if (my $parent = $current->[3]) {
- next if $parent->[0] eq 'root';
- }
- }
- }
+ # Regex
+ my $regex;
- return;
- }
+ # "~=" (word)
+ if ($op eq '~') { $regex = qr/(?:^|.*\s+)$value(?:\s+.*|$)/ }
- return 1;
+ # "*=" (contains)
+ elsif ($op eq '*') { $regex = qr/$value/ }
+
+ # "^=" (begins with)
+ elsif ($op eq '^') { $regex = qr/^$value/ }
+
+ # "$=" (ends with)
+ elsif ($op eq '$') { $regex = qr/$value$/ }
+
+ # Everything else
+ else { $regex = qr/^$value$/ }
+
+ return $regex;
}
sub _css_unescape {
@@ -464,68 +525,287 @@ sub _end {
}
}
-sub _match {
- my ($self, $candidate, $pattern) = @_;
+sub _match_element {
+ my ($self, $candidate, $selectors) = @_;
- # Parts
- my $first = 2;
- for my $part (@$pattern) {
+ # Selectors
+ my @selectors = reverse @$selectors;
- # Selectors
- my @selectors = reverse @$part;
+ # Match
+ my $first = 2;
+ my ($current, $marker, $snapback);
+ my $parentonly = 0;
+ my $siblings;
+ for (my $i = 0; $i <= $#selectors; $i++) {
+ my $selector = $selectors[$i];
- # Match
- my ($current, $marker, $snapback);
- my $parentonly = 0;
- for (my $i = 0; $i <= $#selectors; $i++) {
- my $selector = $selectors[$i];
+ # Combinator
+ $parentonly-- if $parentonly > 0;
+ if ($selector->[0] eq 'combinator') {
# Combinator
- $parentonly-- if $parentonly > 0;
- if ($selector->[0] eq 'combinator') {
-
- # Parent only ">"
- if ($selector->[1] eq '>') {
- $parentonly += 2;
- $marker = $i - 1 unless defined $marker;
- $snapback = $current unless $snapback;
- }
+ my $c = $selector->[1];
- # Move on
- next;
+ # Parent only ">"
+ if ($c eq '>') {
+ $parentonly += 2;
+ $marker = $i - 1 unless defined $marker;
+ $snapback = $current unless $snapback;
}
- while (1) {
- $first-- if $first != 0;
+ # Preceding siblings "~" and "+"
+ elsif ($c eq '~' || $c eq '+') {
+ my $parent = $current->[3];
+ my $start = $parent->[0] eq 'root' ? 1 : 4;
+ $siblings = [];
+
+ # Siblings
+ for my $i ($start .. $#$parent) {
+ my $sibling = $parent->[$i];
+ next unless $sibling->[0] eq 'tag';
+
+ # Reached current
+ if ($sibling eq $current) {
+ @$siblings = ($siblings->[-1]) if $c eq '+';
+ last;
+ }
+ push @$siblings, $sibling;
+ }
+ }
+
+ # Move on
+ next;
+ }
+
+ # Walk backwards
+ while (1) {
+ $first-- if $first != 0;
- # Next parent
+ # Next sibling
+ if ($siblings) {
+
+ # Last sibling
+ unless ($current = shift @$siblings) {
+ $siblings = undef;
+ return;
+ }
+ }
+
+ # Next parent
+ else {
return
unless $current = $current ? $current->[3] : $candidate;
+ }
+
+ # Root
+ return if $current->[0] ne 'tag';
+
+ # Compare part to element
+ if ($self->_match_selector($selector, $current)) {
+ $siblings = undef;
+ last;
+ }
+
+ # First selector needs to match
+ return if $first;
+
+ # Parent only
+ if ($parentonly) {
+ $i = $marker - 1;
+ $current = $snapback;
+ $snapback = undef;
+ $marker = undef;
+ last;
+ }
+ }
+ }
+
+ return 1;
+}
+
+sub _match_selector {
+ my ($self, $selector, $current) = @_;
+
+ # Selectors
+ for my $c (@$selector[1 .. $#$selector]) {
+ my $type = $c->[0];
+
+ # Tag
+ if ($type eq 'tag') {
+ my $type = $c->[1];
+
+ # Wildcard
+ next if $type eq '*';
+
+ # Type (ignore namespace prefix)
+ next if $current->[1] =~ /\:?$type$/;
+ }
+
+ # Attribute
+ elsif ($type eq 'attribute') {
+ my $key = $c->[1];
+ my $regex = $c->[2];
+ my $attrs = $current->[2];
+
+ # Find attributes (ignore namespace prefix)
+ my $found = 0;
+ for my $name (keys %$attrs) {
+ if ($name =~ /\:?$key$/) {
+ ++$found and last
+ if !$regex || ($attrs->{$name} || '') =~ /$regex/;
+ }
+ }
+ next if $found;
+ }
+
+ # Pseudo class
+ elsif ($type eq 'pseudoclass') {
+ my $class = $c->[1];
+ my $args = $c->[2];
+
+ # "first-*"
+ if ($class =~ /^first\-(?:(child)|of-type)$/) {
+ $class = defined $1 ? 'nth-child' : 'nth-of-type';
+ $args = 1;
+ }
+
+ # "last-*"
+ elsif ($class =~ /^last\-(?:(child)|of-type)$/) {
+ $class = defined $1 ? 'nth-last-child' : 'nth-last-of-type';
+ $args = '-n+1';
+ }
+
+ # ":checked"
+ if ($class eq 'checked') {
+ my $attrs = $current->[2];
+ next if ($attrs->{checked} || '') eq 'checked';
+ next if ($attrs->{selected} || '') eq 'selected';
+ }
+
+ # ":empty"
+ elsif ($class eq 'empty') { next unless exists $current->[4] }
+
+ # ":root"
+ elsif ($class eq 'root') {
+ if (my $parent = $current->[3]) {
+ next if $parent->[0] eq 'root';
+ }
+ }
- # Root
- return if $current->[0] ne 'tag';
+ # "not"
+ elsif ($class eq 'not') {
+ next unless $self->_match_selector($args, $current);
+ }
- # Compare part to element
- last if $self->_compare($selector, $current);
+ # "nth-*"
+ elsif ($class =~ /^nth-/) {
+
+ # Numbers
+ $args = $c->[2] = $self->_css_equation($args)
+ unless ref $args;
+
+ # Parent
+ my $parent = $current->[3];
+
+ # Siblings
+ my $start = $parent->[0] eq 'root' ? 1 : 4;
+ my @siblings;
+ my $type = $class =~ /of-type$/ ? $current->[1] : undef;
+ for my $j ($start .. $#$parent) {
+ my $sibling = $parent->[$j];
+ next unless $sibling->[0] eq 'tag';
+ next if defined $type && $type ne $sibling->[1];
+ push @siblings, $sibling;
+ }
- # First selector needs to match
- return if $first;
+ # Reverse
+ @siblings = reverse @siblings if $class =~ /^nth-last/;
+
+ # Find
+ my $found = 0;
+ for my $i (0 .. $#siblings) {
+ my $result = $args->[0] * $i + $args->[1];
+ next if $result < 1;
+ last unless my $sibling = $siblings[$result - 1];
+ if ($sibling eq $current) {
+ $found = 1;
+ last;
+ }
+ }
+ next if $found;
+ }
- # Parent only
- if ($parentonly) {
- $i = $marker - 1;
- $current = $snapback;
- $snapback = undef;
- $marker = undef;
- last;
+ # "only-*"
+ elsif ($class =~ /^only-(?:child|(of-type))$/) {
+ my $type = $1 ? $current->[1] : undef;
+
+ # Parent
+ my $parent = $current->[3];
+
+ # Siblings
+ my $start = $parent->[0] eq 'root' ? 1 : 4;
+ for my $j ($start .. $#$parent) {
+ my $sibling = $parent->[$j];
+ next unless $sibling->[0] eq 'tag';
+ next if $sibling eq $current;
+ next if defined $type && $sibling->[1] ne $type;
+ return if $sibling ne $current;
}
+
+ # No siblings
+ next;
}
}
+
+ return;
}
return 1;
}
+sub _match_tree {
+ my ($self, $tree, $pattern) = @_;
+
+ # Walk tree
+ my @results;
+ my @queue = ($tree);
+ while (my $current = shift @queue) {
+
+ # Type
+ my $type = $current->[0];
+
+ # Root
+ if ($type eq 'root') {
+
+ # Fill queue
+ unshift @queue, @$current[1 .. $#$current];
+ next;
+ }
+
+ # Tag
+ elsif ($type eq 'tag') {
+
+ # Fill queue
+ unshift @queue, @$current[4 .. $#$current];
+
+ # Parts
+ for my $part (@$pattern) {
+
+ # Match
+ push(@results, $current) and last
+ if $self->_match_element($current, $part);
+ }
+ }
+ }
+
+ # Upgrade results
+ @results =
+ map { $self->new(charset => $self->charset, tree => $_) } @results;
+
+ # Collection
+ return bless \@results, 'Mojo::DOM::_Collection';
+}
+
sub _parse_css {
my ($self, $css) = @_;
@@ -562,20 +842,26 @@ sub _parse_css {
# Classes
while ($element =~ /$CSS_CLASS_RE/g) {
- my $class = $self->_css_unescape($1);
push @$selector,
- ['attribute', 'class', qr/(?:^|\W+)$class(?:\W+|$)/];
+ ['attribute', 'class', $self->_css_regex('~', $1)];
}
# ID
if ($element =~ /$CSS_ID_RE/) {
- my $id = $self->_css_unescape($1);
- push @$selector, ['attribute', 'id', qr/^$id$/];
+ push @$selector, ['attribute', 'id', $self->_css_regex('', $1)];
}
# Pseudo classes
while ($pc =~ /$CSS_PSEUDO_CLASS_RE/g) {
- push @$selector, ['pseudoclass', $1, $2];
+
+ # "not"
+ if ($1 eq 'not') {
+ my $subpattern = $self->_parse_css($2)->[-1]->[-1];
+ push @$selector, ['pseudoclass', 'not', $subpattern];
+ }
+
+ # Everything else
+ else { push @$selector, ['pseudoclass', $1, $2] }
}
# Attributes
@@ -584,26 +870,8 @@ sub _parse_css {
my $op = $2 || '';
my $value = $3;
- # Regex
- my $regex;
-
- # Value
- if ($value) {
-
- # Quote
- $value = quotemeta $self->_css_unescape($value);
-
- # "^=" (begins with)
- if ($op eq '^') { $regex = qr/^$value/ }
-
- # "$=" (ends with)
- elsif ($op eq '$') { $regex = qr/$value$/ }
-
- # Everything else
- else { $regex = qr/^$value$/ }
- }
-
- push @$selector, ['attribute', $key, $regex];
+ push @$selector,
+ ['attribute', $key, $self->_css_regex($op, $value)];
}
# Combinator
@@ -622,7 +890,8 @@ sub _parse_xml {
# Decode
my $charset = $self->charset;
- $xml = b($xml)->decode($charset)->to_string if $charset;
+ $xml = b($xml)->decode($charset)->to_string
+ if $charset && !utf8::is_utf8 $xml;
return $tree unless $xml;
# Tokenize
@@ -635,7 +904,7 @@ sub _parse_xml {
my $tag = $6;
# Text
- if ($text) {
+ if (length $text) {
# Unescape
$text = b($text)->html_unescape->to_string if $text =~ /&/;
@@ -690,6 +959,9 @@ sub _parse_xml {
# Start
$self->_start($start, $attrs, \$current);
+
+ # Empty tag
+ $self->_end($start, \$current) if $attr =~ /\/\s*$/;
}
}
@@ -776,44 +1048,6 @@ sub _render {
return $content;
}
-sub _select {
- my ($self, $tree, $pattern) = @_;
-
- # Walk tree
- my @results;
- my @queue = ($tree);
- while (my $current = shift @queue) {
-
- # Type
- my $type = $current->[0];
-
- # Root
- if ($type eq 'root') {
-
- # Fill queue
- unshift @queue, @$current[1 .. $#$current];
- next;
- }
-
- # Tag
- elsif ($type eq 'tag') {
-
- # Fill queue
- unshift @queue, @$current[4 .. $#$current];
-
- # Match
- push @results, $current if $self->_match($current, $pattern);
- }
- }
-
- # Upgrade results
- @results =
- map { $self->new(charset => $self->charset, tree => $_) } @results;
-
- # Collection
- return bless \@results, 'Mojo::DOM::_Collection';
-}
-
# It's not important to talk about who got rich off of whom,
# or who got exposed to tainted what...
sub _start {
@@ -837,15 +1071,24 @@ sub _text {
package Mojo::DOM::_Collection;
-sub each {
- my ($self, $cb) = @_;
+sub each { shift->_iterate(@_) }
+sub until { shift->_iterate(@_, 1) }
+sub while { shift->_iterate(@_, 0) }
+
+sub _iterate {
+ my ($self, $cb, $cond) = @_;
# Shortcut
return @$self unless $cb;
- # Iterate
+ # Iterator
my $i = 1;
- $_->$cb($i++) for @$self;
+
+ # Iterate until condition is true
+ if (defined $cond) { !!$_->$cb($i++) == $cond && last for @$self }
+
+ # Iterate over all elements
+ else { $_->$cb($i++) for @$self }
# Root
return unless my $start = $self->[0];
@@ -857,7 +1100,7 @@ __END__
=head1 NAME
-Mojo::DOM - Minimalistic XML DOM Parser With CSS3 Selectors
+Mojo::DOM - Minimalistic XML/HTML5 DOM Parser With CSS3 Selectors
=head1 SYNOPSIS
@@ -874,15 +1117,28 @@ Mojo::DOM - Minimalistic XML DOM Parser With CSS3 Selectors
# Iterate
$dom->find('div[id]')->each(sub { print shift->text });
+ # Loop
+ for my $e ($dom->find('div[id]')->each) {
+ print $e->text;
+ }
+
+ # Get the first 10 links
+ $dom->find('a[href]')
+ ->while(sub { print shift->attrs->{href} && pop() < 10 });
+
+ # Search for a link about a specific topic
+ $dom->find('a[href]')
+ ->until(sub { $_->text =~ m/kraih/ && print $_->attrs->{href} });
+
=head1 DESCRIPTION
-L<Mojo::DOM> is a minimalistic and very relaxed XML DOM parser with support
-for CSS3 selectors.
+L<Mojo::DOM> is a minimalistic and very relaxed XML/HTML5 DOM parser with
+support for CSS3 selectors.
Note that this module is EXPERIMENTAL and might change without warning!
-=head2 SELECTORS
+=head2 Selectors
-These CSS3 selectors are currently implemented.
+All CSS3 selectors that make sense for a standalone parser are supported.
=over 4
@@ -908,6 +1164,13 @@ An C<E> element with a C<foo> attribute.
An C<E> element whose C<foo> attribute value is exactly equal to C<bar>.
+=item C<E[foo~="bar"]>
+
+ my $fields = $dom->find('input[name~="foo"]');
+
+An C<E> element whose C<foo> attribute value is a list of
+whitespace-separated values, one of which is exactly equal to C<bar>.
+
=item C<E[foo^="bar"]>
my $fields = $dom->find('input[name^="f"]');
@@ -922,12 +1185,109 @@ C<bar>.
An C<E> element whose C<foo> attribute value ends exactly with the string
C<bar>.
+=item C<E[foo*="bar"]>
+
+ my $fields = $dom->find('input[name*="fo"]');
+
+An C<E> element whose C<foo> attribute value contains the substring C<bar>.
+
=item C<E:root>
my $root = $dom->at(':root');
An C<E> element, root of the document.
+=item C<E:checked>
+
+ my $input = $dom->at(':checked');
+
+A user interface element C<E> which is checked (for instance a radio-button
+or checkbox).
+
+=item C<E:empty>
+
+ my $empty = $dom->find(':empty');
+
+An C<E> element that has no children (including text nodes).
+
+=item C<E:nth-child(n)>
+
+ my $third = $dom->at('div:nth-child(3)');
+ my $odd = $dom->find('div:nth-child(odd)');
+ my $even = $dom->find('div:nth-child(even)');
+ my $top3 = $dom->find('div:nth-child(-n+3)');
+
+An C<E> element, the C<n-th> child of its parent.
+
+=item C<E:nth-last-child(n)>
+
+ my $third = $dom->at('div:nth-last-child(3)');
+ my $odd = $dom->find('div:nth-last-child(odd)');
+ my $even = $dom->find('div:nth-last-child(even)');
+ my $bottom3 = $dom->find('div:nth-last-child(-n+3)');
+
+An C<E> element, the C<n-th> child of its parent, counting from the last one.
+
+=item C<E:nth-of-type(n)>
+
+ my $third = $dom->at('div:nth-of-type(3)');
+ my $odd = $dom->find('div:nth-of-type(odd)');
+ my $even = $dom->find('div:nth-of-type(even)');
+ my $top3 = $dom->find('div:nth-of-type(-n+3)');
+
+An C<E> element, the C<n-th> sibling of its type.
+
+=item C<E:nth-last-of-type(n)>
+
+ my $third = $dom->at('div:nth-last-of-type(3)');
+ my $odd = $dom->find('div:nth-last-of-type(odd)');
+ my $even = $dom->find('div:nth-last-of-type(even)');
+ my $bottom3 = $dom->find('div:nth-last-of-type(-n+3)');
+
+An C<E> element, the C<n-th> sibling of its type, counting from the last one.
+
+=item C<E:first-child>
+
+ my $first = $dom->at('div p:first-child');
+
+An C<E> element, first child of its parent.
+
+=item C<E:last-child>
+
+ my $last = $dom->at('div p:last-child');
+
+An C<E> element, last child of its parent.
+
+=item C<E:first-of-type>
+
+ my $first = $dom->at('div p:first-of-type');
+
+An C<E> element, first sibling of its type.
+
+=item C<E:last-of-type>
+
+ my $last = $dom->at('div p:last-of-type');
+
+An C<E> element, last sibling of its type.
+
+=item C<E:only-child>
+
+ my $lonely = $dom->at('div p:only-child');
+
+An C<E> element, only child of its parent.
+
+=item C<E:only-of-type>
+
+ my $lonely = $dom->at('div p:only-of-type');
+
+an C<E> element, only sibling of its type.
+
+=item C<E:not(s)>
+
+ my $others = $dom->at('div p:not(:first-child)');
+
+An C<E> element that does not match simple selector C<s>.
+
=item C<E F>
my $headlines = $dom->find('div h1');
@@ -940,6 +1300,30 @@ An C<F> element descendant of an C<E> element.
An C<F> element child of an C<E> element.
+=item C<E + F>
+
+ my $second = $dom->find('h1 + h2');
+
+An C<F> element immediately preceded by an C<E> element.
+
+=item C<E ~ F>
+
+ my $second = $dom->find('h1 ~ h2');
+
+An C<F> element preceded by an C<E> element.
+
+=item C<E, F, G>
+
+ my $headlines = $dom->find('h1, h2, h3');
+
+Elements of type C<E>, C<F> and C<G>.
+
+=item C<E[foo=bar][bar=baz]>
+
+ my $links = $dom->find('a[foo^="b"][foo$="ar"]');
+
+An C<E> element whose attributes match all following attribute selectors.
+
=back
=head1 ATTRIBUTES
@@ -951,7 +1335,7 @@ L<Mojo::DOM> implements the following attributes.
my $charset = $dom->charset;
$dom = $dom->charset('UTF-8');
-Charset used for decoding XML.
+Charset used for decoding and encoding XML.
=head2 C<tree>
@@ -965,6 +1349,14 @@ Document Object Model.
L<Mojo::DOM> inherits all methods from L<Mojo::Base> and implements the
following new ones.
+=head2 C<after>
+
+ $dom = $dom->after('<p>Hi!</p>');
+
+Add after element.
+
+ $dom->parse('<div><h1>A</h1></div>')->at('h1')->after('<h2>B</h2>');
+
=head2 C<all_text>
my $text = $dom->all_text;
@@ -983,6 +1375,14 @@ Find a single element with CSS3 selectors.
Element attributes.
+=head2 C<before>
+
+ $dom = $dom->before('<p>Hi!</p>');
+
+Add before element.
+
+ $dom->parse('<div><h2>A</h2></div>')->at('h2')->before('<h1>B</h1>');
+
=head2 C<children>
my $children = $dom->children;
@@ -995,14 +1395,16 @@ Children of element.
Find elements with CSS3 selectors.
+ print $dom->find('div')->[23]->text;
$dom->find('div')->each(sub { print shift->text });
+ $dom->find('div')->while(sub { print $_->text && $_->text =~ /foo/ });
+ $dom->find('div')->until(sub { $_->text =~ /foo/ && print $_->text });
-=head2 C<name>
+=head2 C<inner_xml>
- my $name = $dom->name;
- $dom = $dom->name('html');
+ my $xml = $dom->inner_xml;
-Element name.
+Render content of this element to XML.
=head2 C<namespace>
@@ -1028,12 +1430,16 @@ Parse XML document.
Replace elements.
-=head2 C<replace_content>
+ $dom->parse('<div><h1>A</h1></div>')->at('h1')->replace('<h2>B</h2>');
- $dom = $dom->replace_content('test');
+=head2 C<replace_inner>
+
+ $dom = $dom->replace_inner('test');
Replace element content.
+ $dom->parse('<div><h1>A</h1></div>')->at('h1')->replace_inner('B');
+
=head2 C<root>
my $root = $dom->root;
@@ -1052,6 +1458,13 @@ Extract text content from element only, not including child elements.
Render DOM to XML.
+=head2 C<type>
+
+ my $type = $dom->type;
+ $dom = $dom->type('html');
+
+Element type.
+
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
@@ -1,192 +0,0 @@
-package Mojo::Filter::Chunked;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Filter';
-
-# Here's to alcohol, the cause of—and solution to—all life's problems.
-sub build {
- my ($self, $chunk) = @_;
-
- # Done
- return '' if ($self->{_state} || '') eq 'done';
-
- # Shortcut
- return unless defined $chunk;
-
- my $chunk_length = length $chunk;
-
- # Trailing headers
- my $headers = ref $chunk && $chunk->isa('Mojo::Headers') ? 1 : 0;
-
- # End
- my $formatted = '';
- if ($headers || ($chunk_length == 0)) {
- $self->{_state} = 'done';
-
- # Normal end
- $formatted = "\x0d\x0a0\x0d\x0a";
-
- # Trailing headers
- $formatted .= $headers ? "$chunk\x0d\x0a\x0d\x0a" : "\x0d\x0a";
- }
-
- # Separator
- else {
-
- # First chunk has no leading CRLF
- $formatted = "\x0d\x0a" if $self->{_state};
- $self->{_state} = 'chunks';
-
- # Chunk
- $formatted .= sprintf('%x', length $chunk) . "\x0d\x0a$chunk";
- }
-
- return $formatted;
-}
-
-sub is_done {
- return 1 if (shift->{_state} || '') eq 'done';
- return;
-}
-
-sub parse {
- my $self = shift;
-
- # Trailing headers
- if (($self->{_state} || '') eq 'trailing_headers') {
- $self->_parse_trailing_headers;
- return $self;
- }
-
- # New chunk (ignore the chunk extension)
- my $filter = $self->input_buffer;
- my $content = $filter->to_string;
- my $buffer = $self->output_buffer;
- while ($content =~ /^((?:\x0d?\x0a)?([\da-fA-F]+).*\x0d?\x0a)/) {
- my $header = $1;
- my $length = hex($2);
-
- # Last chunk
- if ($length == 0) {
- $filter->remove(length $header);
- $self->{_state} = 'trailing_headers';
- last;
- }
-
- # Read chunk
- else {
-
- # Whole chunk
- if (length $content >= (length($header) + $length)) {
-
- # Remove header
- $content =~ s/^$header//;
- $filter->remove(length $header);
-
- # Remove payload
- substr $content, 0, $length, '';
- $buffer->add_chunk($filter->remove($length));
-
- # Remove newline at end of chunk
- $content =~ s/^(\x0d?\x0a)// and $filter->remove(length $1);
- }
-
- # Not a whole chunk, wait for more data
- else {last}
- }
- }
-
- # Trailing headers
- $self->_parse_trailing_headers
- if ($self->{_state} || '') eq 'trailing_headers';
-}
-
-sub _parse_trailing_headers {
- my $self = shift;
-
- # Parse
- my $headers = $self->headers;
- $headers->parse;
-
- # Done
- if ($headers->is_done) {
- $self->_remove_chunked_encoding;
- $self->{_state} = 'done';
- }
-}
-
-sub _remove_chunked_encoding {
- my $self = shift;
-
- # Remove encoding
- my $headers = $self->headers;
- my $encoding = $headers->transfer_encoding;
- $encoding =~ s/,?\s*chunked//ig;
- $encoding
- ? $headers->transfer_encoding($encoding)
- : $headers->remove('Transfer-Encoding');
- $headers->content_length($self->output_buffer->raw_size);
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Filter::Chunked - HTTP 1.1 Chunked Filter
-
-=head1 SYNOPSIS
-
- use Mojo::Filter::Chunked;
-
- my $chunked = Mojo::Filter::Chunked->new;
-
- $chunked->headers(Mojo::Headers->new);
- $chunked->input_buffer(Mojo::ByteStream->new);
- $chunked->output_buffer(Mojo::ByteStream->new);
-
- $chunked->input_buffer->add_chunk("6\r\nHello!")
- $chunked->parse;
- print $chunked->output_buffer->empty;
-
- print $chunked->build('Hello World!');
-
-=head1 DESCRIPTION
-
-L<Mojo::Filter::Chunked> is a filter for the HTTP 1.1 chunked transfer
-encoding as described in RFC 2616.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Filter::Chunked> inherits all attributes from L<Mojo::Filter>.
-
-=head1 METHODS
-
-L<Mojo::Filter::Chunked> inherits all methods from L<Mojo::Filter> and
-implements the following new ones.
-
-=head2 C<build>
-
- my $formatted = $filter->build('Hello World!');
-
-Build chunked content.
-
-=head2 C<is_done>
-
- my $done = $filter->is_done;
-
-Check if filter is done.
-
-=head2 C<parse>
-
- $filter = $filter->parse;
-
-Filter chunked content.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -1,93 +0,0 @@
-package Mojo::Filter;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use Carp 'croak';
-use Mojo::ByteStream;
-use Mojo::Headers;
-
-__PACKAGE__->attr(headers => sub { Mojo::Headers->new });
-__PACKAGE__->attr(
- [qw/input_buffer output_buffer/] => sub { Mojo::ByteStream->new });
-
-# Quick Smithers. Bring the mind eraser device!
-# You mean the revolver, sir?
-# Precisely.
-sub build { croak 'Method "build" not implemented by subclass' }
-
-sub is_done { croak 'Method "is_done" not implemented by subclass' }
-
-sub parse { croak 'Method "parse" not implemented by subclass' }
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Filter - HTTP 1.1 Filter Base Class
-
-=head1 SYNOPSIS
-
- use base 'Mojo::Filter';
-
-=head1 DESCRIPTION
-
-L<Mojo::Filter> is an abstract base class for HTTP 1.1 filters as described
-in RFC 2616.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Filter> implements the following attributes.
-
-=head2 C<headers>
-
- my $headers = $filter->headers;
- $filter = $filter->headers(Mojo::Headers->new);
-
-The headers.
-
-=head2 C<input_buffer>
-
- my $input_buffer = $filter->input_buffer;
- $filter = $filter->input_buffer(Mojo::ByteStream->new);
-
-Input buffer for filtering.
-
-=head2 C<output_buffer>
-
- my $output_buffer = $filter->output_buffer;
- $filter = $filter->output_buffer(Mojo::ByteStream->new);
-
-Output buffer for filtering.
-
-=head1 METHODS
-
-L<Mojo::Filter> inherits all methods from L<Mojo::Base> and implements the
-following new ones.
-
-=head2 C<build>
-
- my $formatted = $filter->build('Hello World!');
-
-Build filtered content.
-
-=head2 C<is_done>
-
- my $done = $filter->is_done;
-
-Check if filter is done.
-
-=head2 C<parse>
-
- $filter = $filter->parse;
-
-Filter content.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -6,9 +6,9 @@ use warnings;
use base 'Mojo::Base';
use overload '""' => sub { shift->to_string }, fallback => 1;
-use Mojo::ByteStream;
+use Mojo::ByteStream 'b';
-__PACKAGE__->attr(buffer => sub { Mojo::ByteStream->new });
+__PACKAGE__->attr(buffer => sub { b() });
# Headers
my @GENERAL_HEADERS = qw/
@@ -86,9 +86,9 @@ for my $name (@HEADERS) {
$NORMALCASE_HEADERS{$lowercase} = $name;
}
-sub accept_language { shift->header('Accept-Language' => @_) }
-sub accept_ranges { shift->header('Accept-Ranges' => @_) }
-sub authorization { shift->header('Authorization' => @_) }
+sub accept_language { scalar shift->header('Accept-Language' => @_) }
+sub accept_ranges { scalar shift->header('Accept-Ranges' => @_) }
+sub authorization { scalar shift->header('Authorization' => @_) }
sub add {
my $self = shift;
@@ -126,19 +126,19 @@ sub build {
return length $headers ? $headers : undef;
}
-sub connection { shift->header(Connection => @_) }
-sub content_disposition { shift->header('Content-Disposition' => @_) }
-sub content_length { shift->header('Content-Length' => @_) }
-sub content_range { shift->header('Content-Range' => @_) }
+sub connection { scalar shift->header(Connection => @_) }
+sub content_disposition { scalar shift->header('Content-Disposition' => @_) }
+sub content_length { scalar shift->header('Content-Length' => @_) }
+sub content_range { scalar shift->header('Content-Range' => @_) }
sub content_transfer_encoding {
- shift->header('Content-Transfer-Encoding' => @_);
+ scalar shift->header('Content-Transfer-Encoding' => @_);
}
-sub content_type { shift->header('Content-Type' => @_) }
-sub cookie { shift->header(Cookie => @_) }
-sub date { shift->header(Date => @_) }
-sub expect { shift->header(Expect => @_) }
+sub content_type { scalar shift->header('Content-Type' => @_) }
+sub cookie { scalar shift->header(Cookie => @_) }
+sub date { scalar shift->header(Date => @_) }
+sub expect { scalar shift->header(Expect => @_) }
sub from_hash {
my $self = shift;
@@ -191,16 +191,16 @@ sub header {
return @$headers;
}
-sub host { shift->header(Host => @_) }
-sub if_modified_since { shift->header('If-Modified-Since' => @_) }
+sub host { scalar shift->header(Host => @_) }
+sub if_modified_since { scalar shift->header('If-Modified-Since' => @_) }
sub is_done {
return 1 if (shift->{_state} || '') eq 'done';
return;
}
-sub last_modified { shift->header('Last-Modified' => @_) }
-sub location { shift->header(Location => @_) }
+sub last_modified { scalar shift->header('Last-Modified' => @_) }
+sub location { scalar shift->header(Location => @_) }
sub names {
my $self = shift;
@@ -214,7 +214,7 @@ sub names {
return \@headers;
}
-sub origin { shift->header(Origin => @_) }
+sub origin { scalar shift->header(Origin => @_) }
sub parse {
my ($self, $chunk) = @_;
@@ -253,10 +253,10 @@ sub parse {
return;
}
-sub proxy_authenticate { shift->header('Proxy-Authenticate' => @_) }
-sub proxy_authorization { shift->header('Proxy-Authorization' => @_) }
-sub range { shift->header(Range => @_) }
-sub referrer { shift->header(Referer => @_) }
+sub proxy_authenticate { scalar shift->header('Proxy-Authenticate' => @_) }
+sub proxy_authorization { scalar shift->header('Proxy-Authorization' => @_) }
+sub range { scalar shift->header(Range => @_) }
+sub referrer { scalar shift->header(Referer => @_) }
sub remove {
my ($self, $name) = @_;
@@ -264,10 +264,10 @@ sub remove {
return $self;
}
-sub server { shift->header(Server => @_) }
-sub set_cookie { shift->header('Set-Cookie' => @_) }
-sub set_cookie2 { shift->header('Set-Cookie2' => @_) }
-sub status { shift->header(Status => @_) }
+sub server { scalar shift->header(Server => @_) }
+sub set_cookie { scalar shift->header('Set-Cookie' => @_) }
+sub set_cookie2 { scalar shift->header('Set-Cookie2' => @_) }
+sub status { scalar shift->header(Status => @_) }
sub to_hash {
my $self = shift;
@@ -297,16 +297,25 @@ sub to_hash {
sub to_string { shift->build(@_) }
-sub trailer { shift->header(Trailer => @_) }
-sub transfer_encoding { shift->header('Transfer-Encoding' => @_) }
-sub upgrade { shift->header(Upgrade => @_) }
-sub user_agent { shift->header('User-Agent' => @_) }
-sub sec_websocket_key1 { shift->header('Sec-WebSocket-Key1' => @_) }
-sub sec_websocket_key2 { shift->header('Sec-WebSocket-Key2' => @_) }
-sub sec_websocket_location { shift->header('Sec-WebSocket-Location' => @_) }
-sub sec_websocket_origin { shift->header('Sec-WebSocket-Origin' => @_) }
-sub sec_websocket_protocol { shift->header('Sec-WebSocket-Protocol' => @_) }
-sub www_authenticate { shift->header('WWW-Authenticate' => @_) }
+sub trailer { scalar shift->header(Trailer => @_) }
+sub transfer_encoding { scalar shift->header('Transfer-Encoding' => @_) }
+sub upgrade { scalar shift->header(Upgrade => @_) }
+sub user_agent { scalar shift->header('User-Agent' => @_) }
+sub sec_websocket_key1 { scalar shift->header('Sec-WebSocket-Key1' => @_) }
+sub sec_websocket_key2 { scalar shift->header('Sec-WebSocket-Key2' => @_) }
+
+sub sec_websocket_location {
+ scalar shift->header('Sec-WebSocket-Location' => @_);
+}
+
+sub sec_websocket_origin {
+ scalar shift->header('Sec-WebSocket-Origin' => @_);
+}
+
+sub sec_websocket_protocol {
+ scalar shift->header('Sec-WebSocket-Protocol' => @_);
+}
+sub www_authenticate { scalar shift->header('WWW-Authenticate' => @_) }
1;
__END__
@@ -5,7 +5,6 @@ use warnings;
use base 'Mojo';
-use Mojo::Filter::Chunked;
use Mojo::JSON;
# How is education supposed to make me feel smarter? Besides,
@@ -33,6 +32,7 @@ sub handler {
$res->code(200);
$res->headers->content_type('text/plain');
$res->body('Your Mojo is working!');
+ $tx->resume;
}
sub _chunked_params {
@@ -49,23 +49,21 @@ sub _chunked_params {
}
# Callback
- my $counter = 0;
- my $chunked = Mojo::Filter::Chunked->new;
- $tx->res->body(
- sub {
- my $self = shift;
- my $chunk = $chunks->[$counter] || '';
- $counter++;
- return $chunked->build($chunk);
- }
- );
+ my $cb;
+ $cb = sub {
+ my $self = shift;
+ my $chunk = shift @$chunks || '';
+ $self->write_chunk($chunk, $chunk ? $cb : undef);
+ };
+ $cb->($tx->res);
+ $tx->resume;
}
sub _diag {
my ($self, $tx) = @_;
# Finished transaction
- $tx->finished(sub { $ENV{MOJO_HELLO} = 'world' });
+ $tx->on_finish(sub { $ENV{MOJO_HELLO} = 'world' });
# Path
my $path = $tx->req->url->path;
@@ -83,6 +81,7 @@ sub _diag {
return $self->_chunked_params($tx) if $path =~ /^\/chunked_params/;
return $self->_dump_env($tx) if $path =~ /^\/dump_env/;
return $self->_dump_params($tx) if $path =~ /^\/dump_params/;
+ return $self->_upload($tx) if $path =~ /^\/upload/;
return $self->_proxy($tx) if $path =~ /^\/proxy/;
# List
@@ -95,10 +94,12 @@ sub _diag {
<a href="/diag/dump_env">Dump Environment Variables</a><br />
<a href="/diag/dump_params">Dump Request Parameters</a><br />
<a href="/diag/proxy">Proxy</a><br />
+ <a href="/diag/upload">Upload</a><br />
<a href="/diag/websocket">WebSocket</a>
</body>
</html>
EOF
+ $tx->resume;
}
sub _dump_env {
@@ -106,6 +107,7 @@ sub _dump_env {
my $res = $tx->res;
$res->headers->content_type('application/json');
$res->body(Mojo::JSON->new->encode(\%ENV));
+ $tx->resume;
}
sub _dump_params {
@@ -113,6 +115,7 @@ sub _dump_params {
my $res = $tx->res;
$res->headers->content_type('application/json');
$res->body(Mojo::JSON->new->encode($tx->req->params->to_hash));
+ $tx->resume;
}
sub _hello {
@@ -123,6 +126,7 @@ sub _hello {
$res->code(200);
$res->headers->content_type('text/plain');
$res->body('Your Mojo is working!');
+ $tx->resume;
}
sub _proxy {
@@ -140,8 +144,9 @@ sub _proxy {
$tx->res->headers->content_type(
$tx2->res->headers->content_type);
$tx->res->body($tx2->res->content->asset->slurp);
+ $tx->resume;
}
- )->process;
+ )->start;
return;
}
@@ -149,23 +154,18 @@ sub _proxy {
# Async proxy
if (my $url = $tx->req->param('async_url')) {
- # Pause transaction
- $tx->pause;
-
# Fetch
$self->client->async->get(
$url => sub {
my ($self, $tx2) = @_;
- # Resume transaction
- $tx->resume;
-
# Pass through content
$tx->res->headers->content_type(
$tx2->res->headers->content_type);
$tx->res->body($tx2->res->content->asset->slurp);
+ $tx->resume;
}
- )->process;
+ )->start;
return;
}
@@ -192,6 +192,48 @@ sub _proxy {
</body>
</html>
EOF
+ $tx->resume;
+}
+
+sub _upload {
+ my ($self, $tx) = @_;
+
+ # Request
+ my $req = $tx->req;
+
+ # Response
+ my $res = $tx->res;
+ $res->code(200);
+
+ # File
+ if (my $file = $req->upload('file')) {
+ my $headers = $res->headers;
+ $headers->content_type($file->headers->content_type
+ || 'application/octet-stream');
+ $headers->header('X-Upload-Limit-Exceeded' => 1)
+ if $req->is_limit_exceeded;
+ $res->body($file->slurp);
+ }
+
+ # Form
+ else {
+ my $url = $req->url->to_abs;
+ $url->path('/diag/upload');
+ $res->headers->content_type('text/html');
+ $res->body(<<"EOF");
+<!doctype html><html>
+ <head><title>Mojo Diagnostics</title></head>
+ <body>
+ File:
+ <form action="$url" method="POST" enctype="multipart/form-data">
+ <input type="file" name="file" />
+ <input type="submit" value="Upload" />
+ </form>
+ </body>
+</html>
+EOF
+ }
+ $tx->resume;
}
sub _websocket {
@@ -200,13 +242,15 @@ sub _websocket {
# WebSocket request
if ($tx->is_websocket) {
$tx->send_message('Congratulations, your Mojo is working!');
- return $tx->receive_message(
+ $tx->on_message(
sub {
my ($tx, $message) = @_;
return unless $message eq 'test 123';
$tx->send_message('With WebSocket support!');
+ $tx->resume;
}
);
+ return $tx->resume;
}
# WebSocket example
@@ -241,6 +285,7 @@ sub _websocket {
</body>
</html>
EOF
+ $tx->resume;
}
1;
@@ -113,6 +113,8 @@ sub list_files {
return [sort @files];
}
+# And now to create an unstoppable army of between one million and two
+# million zombies!
sub parse {
my ($self, $path) = @_;
my @parts = File::Spec->splitdir($path);
@@ -11,11 +11,14 @@ use File::Spec;
use IO::File;
use IO::Poll qw/POLLERR POLLHUP POLLIN POLLOUT/;
use IO::Socket;
-use Mojo::ByteStream;
+use Mojo::ByteStream 'b';
+use Mojo::URL;
+use Scalar::Util 'weaken';
use Socket qw/IPPROTO_TCP TCP_NODELAY/;
use Time::HiRes 'time';
-use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 262144;
+# Debug
+use constant DEBUG => $ENV{MOJO_IOLOOP_DEBUG} || 0;
# Epoll support requires IO::Epoll
use constant EPOLL => ($ENV{MOJO_POLL} || $ENV{MOJO_KQUEUE})
@@ -26,10 +29,10 @@ use constant EPOLL_POLLHUP => EPOLL ? IO::Epoll::POLLHUP() : 0;
use constant EPOLL_POLLIN => EPOLL ? IO::Epoll::POLLIN() : 0;
use constant EPOLL_POLLOUT => EPOLL ? IO::Epoll::POLLOUT() : 0;
-# IPv6 support requires IO::Socket::INET6
+# IPv6 support requires IO::Socket::IP
use constant IPV6 => $ENV{MOJO_NO_IPV6}
? 0
- : eval 'use IO::Socket::INET6 (); 1';
+ : eval 'use IO::Socket::IP 0.04 (); 1';
# KQueue support requires IO::KQueue
use constant KQUEUE => ($ENV{MOJO_POLL} || $ENV{MOJO_EPOLL})
@@ -48,6 +51,9 @@ use constant TLS => $ENV{MOJO_NO_TLS} ? 0
use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
+# Windows
+use constant WINDOWS => $^O eq 'MSWin32' ? 1 : 0;
+
# Default TLS cert (20.03.2010)
# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
use constant CERT => <<EOF;
@@ -94,19 +100,58 @@ AnqxHi90n/p912ynLg2SjBq+03GaECeGzC/QqKK2gtA=
-----END RSA PRIVATE KEY-----
EOF
+# DNS server (default to Google Public DNS)
+our $DNS_SERVER = '8.8.8.8';
+
+# Try to detect DNS server
+if (-r '/etc/resolv.conf') {
+ my $file = IO::File->new;
+ $file->open('< /etc/resolv.conf');
+ for my $line (<$file>) {
+ if ($line =~ /^nameserver\s+(\S+)$/) {
+
+ # New DNS server
+ $DNS_SERVER = $1;
+
+ # Debug
+ warn qq/DETECTED DNS SERVER ($DNS_SERVER)\n/ if DEBUG;
+ }
+ }
+}
+
+# DNS record types
+my $DNS_TYPES = {
+ A => 0x0001,
+ AAAA => 0x001c,
+ TXT => 0x0010
+};
+
+# "localhost"
+our $LOCALHOST = '127.0.0.1';
+
+__PACKAGE__->attr([qw/accept_timeout connect_timeout dns_timeout/] => 3);
+__PACKAGE__->attr(dns_server => sub { $ENV{MOJO_DNS_SERVER} || $DNS_SERVER });
+__PACKAGE__->attr(max_connections => 1000);
+__PACKAGE__->attr([qw/on_idle on_tick/]);
__PACKAGE__->attr(
- [qw/lock_cb unlock_cb/] => sub {
+ [qw/on_lock on_unlock/] => sub {
sub {1}
}
);
-__PACKAGE__->attr([qw/idle_cb tick_cb/]);
-__PACKAGE__->attr([qw/accept_timeout connect_timeout/] => 5);
-__PACKAGE__->attr(max_connections => 1000);
-__PACKAGE__->attr(timeout => '0.25');
+__PACKAGE__->attr(timeout => '0.25');
# Singleton
our $LOOP;
+# DEPRECATED in Comet!
+*error_cb = \&on_error;
+*hup_cb = \&on_hup;
+*idle_cb = \&on_idle;
+*lock_cb = \&on_lock;
+*read_cb = \&on_read;
+*tick_cb = \&on_tick;
+*unlock_cb = \&on_unlock;
+
sub DESTROY {
my $self = shift;
@@ -140,55 +185,40 @@ sub connect {
# TLS check
return if $args->{tls} && !TLS;
- # Options
- my %options = (
- Blocking => 0,
- PeerAddr => $args->{address},
- PeerPort => $args->{port} || ($args->{tls} ? 443 : 80),
- Proto => 'tcp',
- Type => SOCK_STREAM,
- %{$args->{args} || {}}
- );
-
- # New connection
- my $class = IPV6 ? 'IO::Socket::INET6' : 'IO::Socket::INET';
- return unless my $socket = $args->{socket} || $class->new(%options);
- my $id = "$socket";
+ # Protocol
+ $args->{proto} ||= 'tcp';
- # File descriptor
- return unless defined(my $fd = fileno $socket);
- $self->{_fds}->{$fd} = $id;
-
- # Add connection
- my $c = $self->{_cs}->{$id} = {
- buffer => Mojo::ByteStream->new,
- connect_cb => $args->{connect_cb} || $args->{cb},
- connecting => 1,
- socket => $socket
+ # Connection
+ my $c = {
+ buffer => b(),
+ on_connect => $args->{on_connect}
+ || $args->{connect_cb}
+ || $args->{cb},
+ connecting => 1
};
-
- # Non blocking
- $socket->blocking(0);
-
- # Disable Nagle's algorithm
- setsockopt $socket, IPPROTO_TCP, TCP_NODELAY, 1;
-
- # Timeout
- $c->{connect_timer} =
- $self->timer($self->connect_timeout =>
- sub { shift->_error($id, 'Connect timeout.') });
+ (my $id) = "$c" =~ /0x([\da-f]+)/;
+ $self->{_cs}->{$id} = $c;
# Register callbacks
- for my $name (qw/error_cb hup_cb read_cb/) {
- my $cb = $args->{$name};
- $self->$name($id => $cb) if $cb;
+ for my $name (qw/error hup read/) {
+ my $cb = $args->{"on_$name"} || $args->{"${name}_cb"};
+ my $event = "on_$name";
+ $self->$event($id => $cb) if $cb;
}
- # Add socket to poll
- $self->_not_writing($id);
+ # Lookup
+ if (my $address = $args->{address}) {
+ $self->lookup(
+ $address => sub {
+ my $self = shift;
+ $args->{address} = shift || $args->{address};
+ $self->_connect($id, $args);
+ }
+ );
+ }
- # Start TLS
- if ($args->{tls}) { return unless $id = $self->start_tls($id => $args) }
+ # Connect
+ else { $self->_connect($id, $args) }
return $id;
}
@@ -215,8 +245,6 @@ sub drop {
return $self->_drop_immediately($id);
}
-sub error_cb { shift->_add_event('error', @_) }
-
sub generate_port {
my $self = shift;
@@ -238,8 +266,6 @@ sub generate_port {
return;
}
-sub hup_cb { shift->_add_event('hup', @_) }
-
sub is_running { shift->{_running} }
# Fat Tony is a cancer on this fair city!
@@ -256,21 +282,47 @@ sub listen {
# Options
my %options = (
- Blocking => 0,
- Listen => $args->{queue_size} || SOMAXCONN,
- Type => SOCK_STREAM,
+ Listen => $args->{queue_size} || SOMAXCONN,
+ Proto => 'tcp',
+ Type => SOCK_STREAM,
%{$args->{args} || {}}
);
+ # File
+ my $file = $args->{file};
+
+ # Port
+ my $port = $args->{port} || 3000;
+
+ # File descriptor reuse
+ my $reuse = defined $file ? $file : $port;
+ $ENV{MOJO_REUSE} ||= '';
+ my $fd;
+ if ($ENV{MOJO_REUSE} =~ /(?:^|\,)$reuse\:(\d+)/) { $fd = $1 }
+
+ # Connection
+ my $c = {
+ file => $args->{file} ? 1 : 0,
+ on_accept => $args->{on_accept} || $args->{accept_cb} || $args->{cb},
+ on_error => $args->{on_error} || $args->{error_cb},
+ on_hup => $args->{on_hup} || $args->{hup_cb},
+ on_read => $args->{on_read} || $args->{read_cb},
+ };
+ (my $id) = "$c" =~ /0x([\da-f]+)/;
+ $self->{_listen}->{$id} = $c;
+
# Listen on UNIX domain socket
my $socket;
- if (my $file = $args->{file}) {
+ if (defined $file) {
# Path
$options{Local} = $file;
# Create socket
- $socket = IO::Socket::UNIX->new(%options)
+ $socket =
+ defined $fd
+ ? IO::Socket::UNIX->new
+ : IO::Socket::UNIX->new(%options)
or croak "Can't create listen socket: $!";
}
@@ -279,26 +331,28 @@ sub listen {
# Socket options
$options{LocalAddr} = $args->{address} || (IPV6 ? '::' : '0.0.0.0');
- $options{LocalPort} = $args->{port} || 3000;
+ $options{LocalPort} = $port;
$options{Proto} = 'tcp';
$options{ReuseAddr} = 1;
# Create socket
- my $class = IPV6 ? 'IO::Socket::INET6' : 'IO::Socket::INET';
- $socket = $class->new(%options)
+ my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
+ $socket = defined $fd ? $class->new : $class->new(%options)
or croak "Can't create listen socket: $!";
}
- my $id = "$socket";
- # Add listen socket
- my $c = $self->{_listen}->{$id} = {
- accept_cb => $args->{accept_cb} || $args->{cb},
- error_cb => $args->{error_cb},
- file => $args->{file} ? 1 : 0,
- hup_cb => $args->{hup_cb},
- read_cb => $args->{read_cb},
- socket => $socket
- };
+ # File descriptor
+ if (defined $fd) { $socket->fdopen($fd, 'r') }
+ else {
+ $fd = fileno $socket;
+ $reuse = ",$reuse" if length $ENV{MOJO_REUSE};
+ $ENV{MOJO_REUSE} .= "$reuse:$fd";
+ }
+ $self->{_fds}->{$fd} = $id;
+
+ # Socket
+ $c->{socket} = $socket;
+ $self->{_reverse}->{$socket} = $id;
# TLS options
$c->{tls} = {
@@ -308,10 +362,6 @@ sub listen {
}
if $args->{tls};
- # File descriptor
- my $fd = fileno $socket;
- $self->{_fds}->{$fd} = $id;
-
return $id;
}
@@ -331,6 +381,43 @@ sub local_info {
return {address => $socket->sockhost, port => $socket->sockport};
}
+sub lookup {
+ my ($self, $name, $cb) = @_;
+
+ # "localhost"
+ return $self->timer(0 => sub { shift->$cb($LOCALHOST) })
+ if $name eq 'localhost';
+
+ # IPv4
+ $self->resolve(
+ $name, 'A',
+ sub {
+ my ($self, $results) = @_;
+
+ # Success
+ return $self->$cb($results->[0]) if $results->[0];
+
+ # IPv6
+ $self->resolve(
+ $name, 'AAAA',
+ sub {
+ my ($self, $results) = @_;
+
+ # Success
+ return $self->$cb($results->[0]) if $results->[0];
+
+ # Pass through
+ $self->$cb();
+ }
+ );
+ }
+ );
+}
+
+sub on_error { shift->_add_event('error', @_) }
+sub on_hup { shift->_add_event('hup', @_) }
+sub on_read { shift->_add_event('read', @_) }
+
sub one_tick {
my ($self, $timeout) = @_;
@@ -346,6 +433,9 @@ sub one_tick {
# Loop
my $loop = $self->_prepare_loop;
+ # Reverse map
+ my $r = $self->{_reverse};
+
# Events
my (@error, @hup, @read, @write);
@@ -384,16 +474,16 @@ sub one_tick {
$loop->poll($timeout);
# Read
- push @read, "$_" for $loop->handles(EPOLL_POLLIN);
+ push @read, $r->{$_} for $loop->handles(EPOLL_POLLIN);
# Write
- push @write, "$_" for $loop->handles(EPOLL_POLLOUT);
+ push @write, $r->{$_} for $loop->handles(EPOLL_POLLOUT);
# Error
- push @error, "$_" for $loop->handles(EPOLL_POLLERR);
+ push @error, $r->{$_} for $loop->handles(EPOLL_POLLERR);
# HUP
- push @hup, "$_" for $loop->handles(EPOLL_POLLHUP);
+ push @hup, $r->{$_} for $loop->handles(EPOLL_POLLHUP);
}
# Poll
@@ -401,16 +491,16 @@ sub one_tick {
$loop->poll($timeout);
# Read
- push @read, "$_" for $loop->handles(POLLIN);
+ push @read, $r->{$_} for $loop->handles(POLLIN);
# Write
- push @write, "$_" for $loop->handles(POLLOUT);
+ push @write, $r->{$_} for $loop->handles(POLLOUT);
# Error
- push @error, "$_" for $loop->handles(POLLERR);
+ push @error, $r->{$_} for $loop->handles(POLLERR);
# HUP
- push @hup, "$_" for $loop->handles(POLLHUP);
+ push @hup, $r->{$_} for $loop->handles(POLLHUP);
}
# Read
@@ -429,19 +519,17 @@ sub one_tick {
my $timers = $self->_timer;
# Tick callback
- if (my $cb = $self->tick_cb) {
+ if (my $cb = $self->on_tick) {
$self->_run_callback('tick', $cb);
}
# Idle callback
- if (my $cb = $self->idle_cb) {
+ if (my $cb = $self->on_idle) {
$self->_run_callback('idle', $cb)
unless @read || @write || @error || @hup || $timers;
}
}
-sub read_cb { shift->_add_event('read', @_) }
-
sub remote_info {
my ($self, $id) = @_;
@@ -458,6 +546,140 @@ sub remote_info {
return {address => $socket->peerhost, port => $socket->peerport};
}
+sub resolve {
+ my ($self, $name, $type, $cb) = @_;
+
+ # Regex
+ my $ipv4 = $Mojo::URL::IPV4_RE;
+ my $ipv6 = $Mojo::URL::IPV6_RE;
+
+ # Type
+ my $t = $DNS_TYPES->{$type};
+
+ # Server
+ my $server = $self->dns_server;
+
+ # No lookup required or record type not supported
+ unless ($server && $t && $name !~ $ipv4 && $name !~ $ipv6) {
+ $self->timer(0 => sub { $self->$cb([]) });
+ return $self;
+ }
+
+ # Debug
+ warn "RESOLVE $type $name ($server)\n" if DEBUG;
+
+ # Timer
+ my $timer;
+
+ # Transaction
+ my $tx = int rand 0x10000;
+
+ # Request
+ my $id = $self->connect(
+ address => $server,
+ port => 53,
+ proto => 'udp',
+ on_connect => sub {
+ my ($self, $id) = @_;
+
+ # Header (one question with recursion)
+ my $req = pack 'nnnnnn', $tx, 0x0100, 1, 0, 0, 0;
+
+ # Query (Internet)
+ for my $part (split /\./, $name) {
+ $req .= pack 'C/a', $part if defined $part;
+ }
+ $req .= pack 'Cnn', 0, $t, 0x0001;
+
+ # Write
+ $self->write($id => $req);
+ },
+ on_error => sub {
+ my ($self, $id) = @_;
+
+ # Debug
+ warn "FAILED $type $name ($server)\n" if DEBUG;
+
+ $self->drop($timer) if $timer;
+ $self->$cb([]);
+ },
+ on_read => sub {
+ my ($self, $id, $chunk) = @_;
+
+ # Cleanup
+ $self->drop($id);
+ $self->drop($timer) if $timer;
+
+ # Packet
+ my @packet = unpack 'nnnnnnA*', $chunk;
+
+ # Wrong response
+ return $self->$cb([]) unless $packet[0] eq $tx;
+
+ # Content
+ my $content = $packet[6];
+
+ # Questions
+ for (1 .. $packet[2]) {
+ my $n;
+ do { ($n, $content) = unpack 'C/aA*', $content } while ($n);
+ $content = (unpack 'nnA*', $content)[2];
+ }
+
+ # Answers
+ my @answers;
+ for (1 .. $packet[3]) {
+ my ($t, $a, $answer);
+ ($t, $a, $content) = (unpack 'nnnNn/AA*', $content)[1, 4, 5];
+
+ # A
+ if ($t eq $DNS_TYPES->{A}) {
+ $answer = join('.', unpack 'C*', $a);
+ }
+
+ # AAAA
+ elsif ($t eq $DNS_TYPES->{AAAA}) {
+ $answer = sprintf '%x:%x:%x:%x:%x:%x:%x:%x',
+ unpack('n*', $a);
+ }
+
+ # TXT
+ elsif ($t eq $DNS_TYPES->{TXT}) {
+ $answer = unpack '(C/a*)*', $a;
+ }
+
+ next unless defined $answer;
+ push @answers, $answer;
+
+ # Debug
+ warn "ANSWER $answer\n" if DEBUG;
+ }
+
+ # Done
+ $self->$cb(\@answers);
+ }
+ );
+
+ # Timer
+ $timer = $self->timer(
+ $self->dns_timeout => sub {
+ my $self = shift;
+
+ # Debug
+ warn "RESOLVE TIMEOUT ($server)\n" if DEBUG;
+
+ # Disable
+ $self->dns_server(undef);
+
+ # Abort
+ $self->drop($id);
+ $self->$cb([]);
+ }
+ );
+
+ return $self;
+}
+
sub singleton { $LOOP ||= shift->new(@_) }
sub start {
@@ -486,13 +708,11 @@ sub start_tls {
my $args = ref $_[0] ? $_[0] : {@_};
# Options
- my %options =
- (SSL_startHandshake => 0, Timeout => $self->connect_timeout);
- if ($args->{tls_ca_file}) {
- $options{SSL_ca_file} = $args->{tls_ca_file};
- $options{SSL_verify_mode} = 0x01;
- $options{SSL_verify_callback} = $args->{tls_verify_cb};
- }
+ my %options = (
+ SSL_startHandshake => 0,
+ Timeout => $self->connect_timeout,
+ %{$args->{tls_args} || {}}
+ );
# Connection
$self->drop($id) and return unless my $c = $self->{_cs}->{$id};
@@ -502,6 +722,7 @@ sub start_tls {
my $fd = fileno $socket;
# Cleanup
+ delete $self->{_reverse}->{$socket};
my $writing = delete $c->{writing};
my $loop = $self->_prepare_loop;
if (KQUEUE) {
@@ -514,22 +735,36 @@ sub start_tls {
$self->drop($id) and return
unless my $new = IO::Socket::SSL->start_SSL($socket, %options);
- # Update file descriptor
- delete $self->{_fds}->{$fd};
- $fd = fileno $new;
- $self->{_fds}->{$fd} = "$new";
-
# Upgrade
- $c->{socket} = $new;
- $self->{_cs}->{$new} = delete $self->{_cs}->{$id};
- $c->{tls_connect} = 1;
- $self->_writing("$new");
+ $c->{socket} = $new;
+ $self->{_reverse}->{$new} = $id;
+ $c->{tls_connect} = 1;
+ $self->_writing($id);
- return "$new";
+ return $id;
}
sub stop { delete shift->{_running} }
+sub test {
+ my ($self, $id) = @_;
+
+ # Connection
+ return unless my $c = $self->{_cs}->{$id};
+
+ # Socket
+ return unless my $socket = $c->{socket};
+
+ # Test
+ my $test = $self->{_test} ||= IO::Poll->new;
+ $test->mask($socket, POLLIN);
+ $test->poll(0);
+ my $result = $test->handles(POLLIN | POLLERR | POLLHUP);
+ $test->remove($socket);
+
+ return !$result;
+}
+
sub timer {
my ($self, $after, $cb) = @_;
@@ -537,7 +772,7 @@ sub timer {
my $timer = {after => $after, cb => $cb, started => time};
# Add timer
- my $id = "$timer";
+ (my $id) = "$timer" =~ /0x([\da-f]+)/;
$self->{_ts}->{$id} = $timer;
return $id;
@@ -550,14 +785,18 @@ sub write {
my $c = $self->{_cs}->{$id};
# Buffer
- $c->{buffer} = Mojo::ByteStream->new unless exists $c->{buffer};
+ $c->{buffer} = b() unless exists $c->{buffer};
$c->{buffer}->add_chunk($chunk);
- # Callback
- $c->{drain} = 0 if $cb;
+ # UNIX only
+ unless (WINDOWS) {
+
+ # Callback
+ $c->{drain} = 0 if $cb;
- # Fast write
- $self->_write($id);
+ # Fast write
+ $self->_write($id);
+ }
# Callback
$c->{drain} = $cb if $cb;
@@ -573,23 +812,34 @@ sub _accept {
my $socket = $listen->accept or return;
# Unlock
- $self->unlock_cb->($self);
+ $self->on_unlock->($self);
+
+ # Reverse map
+ my $r = $self->{_reverse};
# Listen
- my $l = $self->{_listen}->{$listen};
+ my $l = $self->{_listen}->{$r->{$listen}};
- # TLS handshake
- my $tls = $l->{tls};
- $socket = IO::Socket::SSL->start_SSL($socket, %$tls) if $tls;
+ # Weaken
+ weaken $self;
- # Add connection
- my $id = "$socket";
- my $c = $self->{_cs}->{$id} = {
+ # Connection
+ my $c = {
accepting => 1,
- buffer => Mojo::ByteStream->new,
- socket => $socket
+ buffer => b(),
};
+ (my $id) = "$c" =~ /0x([\da-f]+)/;
+ $self->{_cs}->{$id} = $c;
+
+ # TLS handshake
+ my $tls = $l->{tls};
+ if ($tls) {
+ $tls->{SSL_error_trap} = sub { $self->_drop_immediately(shift) };
+ $socket = IO::Socket::SSL->start_SSL($socket, %$tls);
+ }
$c->{tls_accept} = 1 if $tls;
+ $c->{socket} = $socket;
+ $r->{$socket} = $id;
# Timeout
$c->{accept_timer} =
@@ -604,13 +854,13 @@ sub _accept {
$self->{_fds}->{$fd} = $id;
# Register callbacks
- for my $name (qw/error_cb hup_cb read_cb/) {
+ for my $name (qw/on_error on_hup on_read/) {
my $cb = $l->{$name};
$self->$name($id => $cb) if $cb;
}
# Accept callback
- my $cb = $l->{accept_cb};
+ my $cb = $l->{on_accept};
$self->_run_event('accept', $cb, $id) if $cb;
# Remove listen sockets
@@ -644,6 +894,50 @@ sub _add_event {
return $self;
}
+sub _connect {
+ my ($self, $id, $args) = @_;
+
+ # Connection
+ return unless my $c = $self->{_cs}->{$id};
+
+ # Options
+ my %options = (
+ PeerAddr => $args->{address},
+ PeerPort => $args->{port} || ($args->{tls} ? 443 : 80),
+ Proto => $args->{proto},
+ Type => $args->{proto} eq 'udp' ? SOCK_DGRAM : SOCK_STREAM,
+ %{$args->{args} || {}}
+ );
+
+ # Socket
+ my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
+ return $self->_error($id, "Couldn't connect.")
+ unless my $socket = $args->{socket} || $class->new(%options);
+ $c->{socket} = $socket;
+ $self->{_reverse}->{$socket} = $id;
+
+ # File descriptor
+ return unless defined(my $fd = fileno $socket);
+ $self->{_fds}->{$fd} = $id;
+
+ # Non-blocking
+ $socket->blocking(0);
+
+ # Disable Nagle's algorithm
+ setsockopt $socket, IPPROTO_TCP, TCP_NODELAY, 1;
+
+ # Timer
+ $c->{connect_timer} =
+ $self->timer($self->connect_timeout =>
+ sub { shift->_error($id, 'Connect timeout.') });
+
+ # Add socket to poll
+ $self->_not_writing($id);
+
+ # Start TLS
+ if ($args->{tls}) { $self->start_tls($id => $args) }
+}
+
sub _drop_immediately {
my ($self, $id) = @_;
@@ -657,6 +951,7 @@ sub _drop_immediately {
# Delete connection
my $c = delete $self->{_cs}->{$id};
+ delete $self->{_reverse}->{$id};
# Drop listen socket
if (!$c && ($c = delete $self->{_listen}->{$id})) {
@@ -705,8 +1000,11 @@ sub _drop_immediately {
sub _error {
my ($self, $id, $error) = @_;
+ # Connection
+ return unless my $c = $self->{_cs}->{$id};
+
# Get error callback
- my $event = $self->{_cs}->{$id}->{error};
+ my $event = $c->{error};
# Cleanup
$self->_drop_immediately($id);
@@ -798,7 +1096,7 @@ sub _prepare_accept {
# Remove timeout
$self->_drop_immediately(delete $c->{accept_timer});
- # Non blocking
+ # Non-blocking
$c->{socket}->blocking(0);
# Add socket to poll
@@ -830,7 +1128,8 @@ sub _prepare_connect {
my $c = $self->{_cs}->{$id};
# Not yet connected
- return unless $c->{socket}->connected;
+ return unless my $socket = $c->{socket};
+ if ($socket->can('connected')) { return unless $socket->connected }
# Connected
delete $c->{connecting};
@@ -839,7 +1138,7 @@ sub _prepare_connect {
$self->_drop_immediately(delete $c->{connect_timer});
# Connect callback
- my $cb = $c->{connect_cb};
+ my $cb = $c->{on_connect};
$self->_run_event('connect', $cb, $id) if $cb;
}
@@ -862,7 +1161,7 @@ sub _prepare_connections {
if ($c->{finish}) {
# Buffer empty
- unless ($c->{buffer} && !$c->{buffer}->size) {
+ unless (defined $c->{buffer} && $c->{buffer}->size) {
$self->_drop_immediately($id);
next;
}
@@ -918,7 +1217,7 @@ sub _prepare_listen {
return unless $i < $self->max_connections;
# Lock
- return unless $self->lock_cb->($self, !$i);
+ return unless $self->on_lock->($self, !$i);
# Add listen sockets
for my $lid (keys %$listen) {
@@ -960,12 +1259,7 @@ sub _read {
my ($self, $id) = @_;
# Listen socket (new connection)
- my $found;
- my $listen = $self->{_listen} || {};
- if (my $l = $listen->{$id}) { $found = $l->{socket} }
-
- # Accept new connection
- return $self->_accept($found) if $found;
+ if (my $l = $self->{_listen}->{$id}) { $self->_accept($l->{socket}) }
# Connection
my $c = $self->{_cs}->{$id};
@@ -1077,7 +1371,6 @@ sub _tls_accept {
# Connected
if ($c->{socket}->accept_SSL) {
delete $c->{tls_accept};
- $self->_writing($id);
return;
}
@@ -1103,7 +1396,6 @@ sub _tls_connect {
# Connected
if ($c->{socket}->connect_SSL) {
delete $c->{tls_connect};
- $self->_writing($id);
return;
}
@@ -1218,7 +1510,7 @@ __END__
=head1 NAME
-Mojo::IOLoop - Minimalistic Reactor For TCP Clients And Servers
+Mojo::IOLoop - Minimalistic Reactor For Non-Blocking TCP Clients And Servers
=head1 SYNOPSIS
@@ -1230,7 +1522,7 @@ Mojo::IOLoop - Minimalistic Reactor For TCP Clients And Servers
# Listen on port 3000
$loop->listen(
port => 3000,
- read_cb => sub {
+ on_read => sub {
my ($self, $id, $chunk) = @_;
# Process input
@@ -1246,13 +1538,13 @@ Mojo::IOLoop - Minimalistic Reactor For TCP Clients And Servers
address => 'localhost',
port => 3000,
tls => 1,
- connect_cb => sub {
+ on_connect => sub {
my ($self, $id) = @_;
# Write request
$self->write($id, "GET / HTTP/1.1\r\n\r\n");
},
- read_cb => sub {
+ on_read => sub {
my ($self, $id, $chunk) = @_;
# Process input
@@ -1273,10 +1565,10 @@ Mojo::IOLoop - Minimalistic Reactor For TCP Clients And Servers
=head1 DESCRIPTION
L<Mojo::IOLoop> is a very minimalistic reactor that has been reduced to the
-absolute minimal feature set required to build solid and scalable TCP clients
-and servers.
+absolute minimal feature set required to build solid and scalable
+non-blocking TCP clients and servers.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::INET6> and
+Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
L<IO::Socket::SSL> are supported transparently and used if installed.
A TLS certificate and key are also built right in to make writing test
@@ -1292,7 +1584,7 @@ L<Mojo::IOLoop> implements the following attributes.
$loop = $loop->accept_timeout(5);
Maximum time in seconds a connection can take to be accepted before being
-dropped, defaults to C<5>.
+dropped, defaults to C<3>.
=head2 C<connect_timeout>
@@ -1300,32 +1592,24 @@ dropped, defaults to C<5>.
$loop = $loop->connect_timeout(5);
Maximum time in seconds a conenction can take to be connected before being
-dropped, defaults to C<5>.
+dropped, defaults to C<3>.
-=head2 C<idle_cb>
+=head2 C<dns_server>
- my $cb = $loop->idle_cb;
- $loop = $loop->idle_cb(sub {...});
+ my $server = $loop->dns_server;
+ $loop = $loop->dns_server('8.8.8.8');
-Callback to be invoked on every reactor tick if no events occurred.
+C<DNS> server to use for non-blocking lookups, defaults to the value of
+C<MOJO_DNS_SERVER>, auto detection or C<8.8.8.8>.
Note that this attribute is EXPERIMENTAL and might change without warning!
-=head2 C<lock_cb>
-
- my $cb = $loop->lock_cb;
- $loop = $loop->lock_cb(sub {...});
-
-A locking callback that decides if this loop is allowed to accept new
-incoming connections, used to sync multiple server processes.
-The callback should return true or false.
-Note that exceptions in this callback are not captured.
+=head2 C<dns_timeout>
- $loop->lock_cb(sub {
- my ($loop, $blocking) = @_;
+ my $timeout = $loop->dns_timeout;
+ $loop = $loop->dns_timeout(5);
- # Got the lock, listen for new connections
- return 1;
- });
+Maximum time in seconds a C<DNS> lookup can take, defaults to C<3>.
+Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<max_connections>
@@ -1338,20 +1622,53 @@ Setting the value to C<0> will make this loop stop accepting new connections
and allow it to shutdown gracefully without interrupting existing
connections.
-=head2 C<tick_cb>
+=head2 C<on_idle>
+
+ my $cb = $loop->on_idle;
+ $loop = $loop->on_idle(sub {...});
+
+Callback to be invoked on every reactor tick if no events occurred.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
+=head2 C<on_lock>
+
+ my $cb = $loop->on_lock;
+ $loop = $loop->on_lock(sub {...});
+
+A locking callback that decides if this loop is allowed to accept new
+incoming connections, used to sync multiple server processes.
+The callback should return true or false.
+Note that exceptions in this callback are not captured.
+
+ $loop->on_lock(sub {
+ my ($loop, $blocking) = @_;
+
+ # Got the lock, listen for new connections
+ return 1;
+ });
+
+=head2 C<on_tick>
- my $cb = $loop->tick_cb;
- $loop = $loop->tick_cb(sub {...});
+ my $cb = $loop->on_tick;
+ $loop = $loop->on_tick(sub {...});
Callback to be invoked on every reactor tick, this for example allows you to
run multiple reactors next to each other.
my $loop2 = Mojo::IOLoop->new(timeout => 0);
- Mojo::IOLoop->singleton->tick_cb(sub { $loop2->one_tick });
+ Mojo::IOLoop->singleton->on_tick(sub { $loop2->one_tick });
Note that the loop timeout can be changed dynamically at any time to adjust
responsiveness.
+=head2 C<on_unlock>
+
+ my $cb = $loop->on_unlock;
+ $loop = $loop->on_unlock(sub {...});
+
+A callback to free the accept lock, used to sync multiple server processes.
+Note that exceptions in this callback are not captured.
+
=head2 C<timeout>
my $timeout = $loop->timeout;
@@ -1359,15 +1676,7 @@ responsiveness.
Maximum time in seconds our loop waits for new events to happen, defaults to
C<0.25>.
-Note that a value of C<0> would make the loop non blocking.
-
-=head2 C<unlock_cb>
-
- my $cb = $loop->unlock_cb;
- $loop = $loop->unlock_cb(sub {...});
-
-A callback to free the accept lock, used to sync multiple server processes.
-Note that exceptions in this callback are not captured.
+Note that a value of C<0> would make the loop non-blocking.
=head1 METHODS
@@ -1396,7 +1705,7 @@ possible.
Open a TCP connection to a remote host, IPv6 will be used automatically if
available.
-Note that IPv6 support depends on L<IO::Socket::INET6> and TLS support on
+Note that IPv6 support depends on L<IO::Socket::IP> and TLS support on
L<IO::Socket::SSL>.
These options are currently available.
@@ -1407,25 +1716,29 @@ These options are currently available.
Address or host name of the peer to connect to.
-=item C<connect_cb>
+=item C<on_connect>
Callback to be invoked once the connection is established.
-=item C<error_cb>
+=item C<on_error>
Callback to be invoked if an error event happens on the connection.
-=item C<hup_cb>
+=item C<on_hup>
Callback to be invoked if the connection gets closed.
+=item C<on_read>
+
+Callback to be invoked if new data arrives on the connection.
+
=item C<port>
Port to connect to.
-=item C<read_cb>
+=item C<proto>
-Callback to be invoked if new data arrives on the connection.
+Protocol to use, defaults to C<tcp>.
=item C<socket>
@@ -1435,14 +1748,6 @@ Use an already prepared socket handle.
Enable TLS.
-=item C<tls_ca_file>
-
-CA file to use for TLS.
-
-=item C<tls_verify_cb>
-
-Callback to invoke for TLS verification.
-
=back
=head2 C<connection_timeout>
@@ -1461,24 +1766,12 @@ Drop a connection, listen socket or timer.
Connections will be dropped gracefully by allowing them to finish writing all
data in it's write buffer.
-=head2 C<error_cb>
-
- $loop = $loop->error_cb($id => sub {...});
-
-Callback to be invoked if an error event happens on the connection.
-
=head2 C<generate_port>
my $port = $loop->generate_port;
Find a free TCP port, this is a utility function primarily used for tests.
-=head2 C<hup_cb>
-
- $loop = $loop->hup_cb($id => sub {...});
-
-Callback to be invoked if the connection gets closed.
-
=head2 C<is_running>
my $running = $loop->is_running;
@@ -1500,7 +1793,7 @@ Check if loop is running.
);
Create a new listen socket, IPv6 will be used automatically if available.
-Note that IPv6 support depends on L<IO::Socket::INET6> and TLS support on
+Note that IPv6 support depends on L<IO::Socket::IP> and TLS support on
L<IO::Socket::SSL>.
These options are currently available.
@@ -1511,21 +1804,25 @@ These options are currently available.
Local address to listen on, defaults to all.
-=item C<accept_cb>
+=item C<file>
+
+A unix domain socket to listen on.
+
+=item C<on_accept>
Callback to invoke for each accepted connection.
-=item C<error_cb>
+=item C<on_error>
Callback to be invoked if an error event happens on the connection.
-=item C<file>
+=item C<on_hup>
-A unix domain socket to listen on.
+Callback to be invoked if the connection gets closed.
-=item C<hup_cb>
+=item C<on_read>
-Callback to be invoked if the connection gets closed.
+Callback to be invoked if new data arrives on the connection.
=item C<port>
@@ -1535,10 +1832,6 @@ Port to listen on.
Maximum queue size, defaults to C<SOMAXCONN>.
-=item C<read_cb>
-
-Callback to be invoked if new data arrives on the connection.
-
=item C<tls>
Enable TLS.
@@ -1575,26 +1868,50 @@ The local port.
=back
-=head2 C<one_tick>
+=head2 C<lookup>
- $loop->one_tick;
- $loop->one_tick('0.25');
- $loop->one_tick(0);
+ $loop = $loop->lookup('mojolicio.us' => sub {...});
-Run reactor for exactly one tick.
+Lookup C<IPv4> or C<IPv6> address for domain.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+ $loop->lookup('mojolicio.us' => sub {
+ my ($loop, $address) = @_;
+ print "Address: $address\n";
+ });
+
+=head2 C<on_error>
+
+ $loop = $loop->on_error($id => sub {...});
+
+Callback to be invoked if an error event happens on the connection.
+
+=head2 C<on_hup>
-=head2 C<read_cb>
+ $loop = $loop->on_hup($id => sub {...});
- $loop = $loop->read_cb($id => sub {...});
+Callback to be invoked if the connection gets closed.
+
+=head2 C<on_read>
+
+ $loop = $loop->on_read($id => sub {...});
Callback to be invoked if new data arrives on the connection.
- $loop->read_cb($id => sub {
+ $loop->on_read($id => sub {
my ($loop, $id, $chunk) = @_;
# Process chunk
});
+=head2 C<one_tick>
+
+ $loop->one_tick;
+ $loop->one_tick('0.25');
+ $loop->one_tick(0);
+
+Run reactor for exactly one tick.
+
=head2 C<remote_info>
my $info = $loop->remote_info($id);
@@ -1617,6 +1934,13 @@ The remote port.
=back
+=head2 C<resolve>
+
+ $loop = $loop->resolve('mojolicio.us', 'A', sub {...});
+
+Resolve domain into C<A>, C<AAAA> or C<TXT> records.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<singleton>
my $loop = Mojo::IOLoop->singleton;
@@ -1634,25 +1958,10 @@ if the loop is already running.
=head2 C<start_tls>
my $id = $loop->start_tls($id);
- my $id = $loop->start_tls($id => {tls_ca_file => '/etc/tls/cacerts.pem'});
Start new TLS connection inside old connection.
Note that TLS support depends on L<IO::Socket::SSL>.
-These options are currently available.
-
-=over 4
-
-=item C<tls_ca_file>
-
-CA file to use for TLS.
-
-=item C<tls_verify_cb>
-
-Callback to invoke for TLS verification.
-
-=back
-
=head2 C<stop>
$loop->stop;
@@ -1660,6 +1969,13 @@ Callback to invoke for TLS verification.
Stop the loop immediately, this will not interrupt any existing connections
and the loop can be restarted by running C<start> again.
+=head2 C<test>
+
+ my $success = $loop->test($id);
+
+Test for errors and garbage bytes on the connection.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<timer>
my $id = $loop->timer(5 => sub {...});
@@ -60,6 +60,8 @@ sub is_level {
sub is_warn { shift->is_level('warn') }
+# If The Flintstones has taught us anything,
+# it's that pelicans can be used to mix cement.
sub log {
my ($self, $level, @msgs) = @_;
@@ -68,7 +70,8 @@ sub log {
return $self unless $level && $self->is_level($level);
my $time = localtime(time);
- my $msgs = join "\n", @msgs;
+ my $msgs = join "\n",
+ map { utf8::decode $_ unless utf8::is_utf8 $_; $_ } @msgs;
# Caller
my ($pkg, $line) = (caller())[0, 2];
@@ -290,13 +290,12 @@ sub _parse_env {
# Scheme/Version
if (my $value = $env->{SERVER_PROTOCOL}) {
$value =~ /^([^\/]*)\/*(.*)$/;
- $self->url->scheme($1) if $1;
$self->url->base->scheme($1) if $1;
- $self->version($2) if $2;
+ $self->version($2) if $2;
}
# HTTPS
- if ($env->{HTTPS}) { $self->url->scheme('https') }
+ if ($env->{HTTPS}) { $self->url->base->scheme('https') }
# Base path
if (my $value = $env->{SCRIPT_NAME}) {
@@ -16,8 +16,8 @@ my $START_LINE_RE = qr/
HTTP\/(\d)\.(\d) # Version
\s+ # Whitespace
(\d\d\d) # Code
- \s+ # Whitespace
- ([\w\'\s]+) # Message (with "I'm a teapot" support)
+ \s* # Whitespace
+ ([\w\'\s]+)? # Message (with "I'm a teapot" support)
$ # End
/x;
@@ -128,24 +128,6 @@ sub is_status_class {
return;
}
-sub parse {
- my ($self, $chunk) = @_;
-
- # Buffer
- $self->buffer->add_chunk($chunk) if defined $chunk;
-
- return $self->_parse(0);
-}
-
-sub parse_until_body {
- my ($self, $chunk) = @_;
-
- # Buffer
- $self->buffer->add_chunk($chunk);
-
- return $self->_parse(1);
-}
-
sub _build_start_line {
my $self = shift;
@@ -209,8 +191,11 @@ sub _parse_start_line {
$self->code($3);
$self->message($4);
$self->{_state} = 'content';
+ $self->at_least_version('1.1')
+ ? $self->content->auto_relax(1)
+ : $self->content->relaxed(1);
}
- else { $self->error('Bad response start line.', 400) }
+ else { $self->error('Bad response start line.') }
}
}
@@ -289,18 +274,6 @@ Make sure message has all required headers for the current HTTP version.
Check response status class.
-=head2 C<parse>
-
- $res = $res->parse('HTTP/1.1 200 OK');
-
-Parse HTTP response chunk.
-
-=head2 C<parse_until_body>
-
- $res = $res->parse_until_body('HTTP/1.1 200 OK');
-
-Parse HTTP response chunk until the body is reached.
-
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
@@ -16,13 +16,21 @@ use Mojo::Upload;
use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 262144;
-__PACKAGE__->attr(buffer => sub { Mojo::ByteStream->new });
+__PACKAGE__->attr(buffer => sub { b() });
__PACKAGE__->attr(content => sub { Mojo::Content::Single->new });
-__PACKAGE__->attr(default_charset => 'UTF-8');
-__PACKAGE__->attr(dom_class => 'Mojo::DOM');
-__PACKAGE__->attr([qw/finish_cb progress_cb/]);
+__PACKAGE__->attr(default_charset => 'UTF-8');
+__PACKAGE__->attr(dom_class => 'Mojo::DOM');
__PACKAGE__->attr(json_class => 'Mojo::JSON');
__PACKAGE__->attr([qw/major_version minor_version/] => 1);
+__PACKAGE__->attr(max_line_size => sub { $ENV{MOJO_MAX_LINE_SIZE} || 10240 });
+__PACKAGE__->attr(
+ max_message_size => sub { $ENV{MOJO_MAX_MESSAGE_SIZE} || 5242880 });
+__PACKAGE__->attr([qw/on_finish on_progress/]);
+
+# DEPRECATED in Comet!
+*finish_cb = \&on_finish;
+*progress_cb = \&on_progress;
+*read_cb = \&on_read;
# I'll keep it short and sweet. Family. Religion. Friendship.
# These are the three demons you must slay if you wish to succeed in
@@ -50,8 +58,8 @@ sub body {
# Get
unless (@_) {
- return $self->body_cb
- ? $self->body_cb
+ return $self->on_read
+ ? $self->on_read
: return $self->content->asset->slurp;
}
@@ -59,14 +67,14 @@ sub body {
my $content = shift;
# Cleanup
- $self->body_cb(undef);
+ $self->on_read(undef);
$self->content->asset(Mojo::Asset::Memory->new);
# Shortcut
return $self unless defined $content;
# Callback
- if (ref $content eq 'CODE') { $self->body_cb($content) }
+ if (ref $content eq 'CODE') { $self->on_read($content) }
# Set text content
elsif (length $content) { $self->content->asset->add_chunk($content) }
@@ -74,8 +82,6 @@ sub body {
return $self;
}
-sub body_cb { shift->content->body_cb(@_) }
-
sub body_params {
my $self = shift;
@@ -147,7 +153,7 @@ sub build_body {
# Finished
$self->{_state} = 'done';
- if (my $cb = $self->finish_cb) { $self->$cb }
+ if (my $cb = $self->on_finish) { $self->$cb }
return $body;
}
@@ -242,7 +248,12 @@ sub dom {
and $charset = $1;
# Parse
- return $class->new(charset => $charset)->parse($self->body);
+ my $dom = $class->new(charset => $charset)->parse($self->body);
+
+ # Find right away
+ return $dom->find(@_) if @_;
+
+ return $dom;
}
sub error {
@@ -261,14 +272,16 @@ sub error {
return $self;
}
+sub finish { shift->content->finish(@_) }
+
sub fix_headers {
my $self = shift;
# Content-Length header is required in HTTP 1.0 (and above)
if ($self->at_least_version('1.0') && !$self->is_chunked) {
- my $size = $self->body_size;
- $self->headers->content_length($size)
- if $size && !$self->headers->content_length;
+ my $headers = $self->headers;
+ $headers->content_length($self->body_size)
+ unless $headers->content_length;
}
return $self;
@@ -278,15 +291,15 @@ sub get_body_chunk {
my $self = shift;
# Progress
- if (my $cb = $self->progress_cb) { $self->$cb('body', @_) }
+ if (my $cb = $self->on_progress) { $self->$cb('body', @_) }
# Chunk
my $chunk = $self->content->get_body_chunk(@_);
- return $chunk if length $chunk || !defined $chunk;
+ return $chunk if !defined $chunk || length $chunk;
# Finish
$self->{_state} = 'done';
- if (my $cb = $self->finish_cb) { $self->$cb }
+ if (my $cb = $self->on_finish) { $self->$cb }
return $chunk;
}
@@ -295,7 +308,7 @@ sub get_header_chunk {
my $self = shift;
# Progress
- if (my $cb = $self->progress_cb) { $self->$cb('headers', @_) }
+ if (my $cb = $self->on_progress) { $self->$cb('headers', @_) }
# HTTP 0.9 has no headers
return '' if $self->version eq '0.9';
@@ -310,7 +323,7 @@ sub get_start_line_chunk {
my ($self, $offset) = @_;
# Progress
- if (my $cb = $self->progress_cb) { $self->$cb('start_line', @_) }
+ if (my $cb = $self->on_progress) { $self->$cb('start_line', @_) }
my $copy = $self->_build_start_line;
return substr($copy, $offset, CHUNK_SIZE);
@@ -347,6 +360,13 @@ sub is_done {
return;
}
+sub is_limit_exceeded {
+ my $self = shift;
+ return unless my $code = ($self->error)[1];
+ return unless $code eq '413';
+ return 1;
+}
+
sub is_multipart { shift->content->is_multipart }
sub json {
@@ -393,6 +413,8 @@ sub parse_until_body {
return $self->_parse(1);
}
+sub on_read { shift->content->on_read(@_) }
+
sub start_line_size { length shift->build_start_line }
sub to_string { shift->build(@_) }
@@ -480,6 +502,9 @@ sub version {
return $self;
}
+sub write { shift->content->write(@_) }
+sub write_chunk { shift->content->write_chunk(@_) }
+
sub _build_start_line {
croak 'Method "_build_start_line" not implemented by subclass';
}
@@ -488,21 +513,18 @@ sub _parse {
my $self = shift;
my $until_body = @_ ? shift : 0;
- # Progress
- if (my $cb = $self->progress_cb) { $self->$cb }
-
# Start line and headers
my $buffer = $self->buffer;
if (!$self->{_state} || $self->{_state} eq 'headers') {
# Check line size
$self->error('Maximum line size exceeded.', 413)
- if $buffer->size > ($ENV{MOJO_MAX_LINE_SIZE} || 10240);
+ if $buffer->size > $self->max_line_size;
}
# Check message size
$self->error('Maximum message size exceeded.', 413)
- if $buffer->raw_size > ($ENV{MOJO_MAX_MESSAGE_SIZE} || 5242880);
+ if $buffer->raw_size > $self->max_message_size;
# Content
my $state = $self->{_state} || '';
@@ -510,7 +532,7 @@ sub _parse {
my $content = $self->content;
# Parse
- $content->filter_buffer($buffer);
+ $content->chunked_buffer($buffer);
# Until body
if ($until_body) { $self->content($content->parse_until_body) }
@@ -530,8 +552,11 @@ sub _parse {
# Done
$self->{_state} = 'done' if $self->content->is_done;
+ # Progress
+ if (my $cb = $self->on_progress) { $self->$cb }
+
# Finished
- if ((my $cb = $self->finish_cb) && $self->is_done) { $self->$cb }
+ if ((my $cb = $self->on_finish) && $self->is_done) { $self->$cb }
return $self;
}
@@ -627,22 +652,6 @@ in RFC 2616 and RFC 2388.
L<Mojo::Message> implements the following attributes.
-=head2 C<body_cb>
-
- my $cb = $message->body_cb;
-
- $counter = 1;
- $message = $message->body_cb(sub {
- my $self = shift;
- my $chunk = '';
- $chunk = "hello world!" if $counter == 1;
- $chunk = "hello world2!\n\n" if $counter == 2;
- $counter++;
- return $chunk;
- });
-
-Content generator callback.
-
=head2 C<buffer>
my $buffer = $message->buffer;
@@ -652,7 +661,7 @@ Input buffer for parsing.
=head2 C<content>
- my $content = $message->content;
+ my $message = $message->content;
$message = $message->content(Mojo::Content::Single->new);
Content container, defaults to a L<Mojo::Content::Single> object.
@@ -672,15 +681,6 @@ Default charset used for form data parsing.
Class to be used for DOM manipulation, defaults to L<Mojo::DOM>.
Note that this attribute is EXPERIMENTAL and might change without warning!
-=head2 C<finish_cb>
-
- my $cb = $message->finish_cb;
- $message = $message->finish_cb(sub {
- my $self = shift;
- });
-
-Callback called after message building or parsing is finished.
-
=head2 C<json_class>
my $class = $message->json_class;
@@ -697,6 +697,22 @@ Note that this attribute is EXPERIMENTAL and might change without warning!
Major version, defaults to C<1>.
+=head2 C<max_line_size>
+
+ my $size = $message->max_line_size;
+ $message = $message->max_line_size(1024);
+
+Maximum line size in bytes, defaults to C<10240>.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
+=head2 C<max_message_size>
+
+ my $size = $message->max_message_size;
+ $message = $message->max_message_size(1024);
+
+Maximum message size in bytes, defaults to C<5242880>.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
=head2 C<minor_version>
my $minor_version = $message->minor_version;
@@ -704,16 +720,39 @@ Major version, defaults to C<1>.
Minor version, defaults to C<1>.
-=head2 C<progress_cb>
+=head2 C<on_finish>
+
+ my $cb = $message->on_finish;
+ $message = $message->on_finish(sub {
+ my $self = shift;
+ });
+
+Callback called after message building or parsing is finished.
+
+=head2 C<on_progress>
- my $cb = $message->progress_cb;
- $message = $message->progress_cb(sub {
+ my $cb = $message->on_progress;
+ $message = $message->on_progress(sub {
my $self = shift;
print '+';
});
Progress callback.
+=head2 C<on_read>
+
+ my $cb = $message->on_read;
+ $message = $message->on_read(sub {...});
+
+Content parser callback.
+
+ $message = $message->on_read(sub {
+ my ($self, $chunk) = @_;
+ print $chunk;
+ });
+
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
=head1 METHODS
L<Mojo::Message> inherits all methods from L<Mojo::Base> and implements the
@@ -729,16 +768,7 @@ Check if message is at least a specific version.
my $string = $message->body;
$message = $message->body('Hello!');
-
- $counter = 1;
- $message = $message->body(sub {
- my $self = shift;
- my $chunk = '';
- $chunk = "hello world!" if $counter == 1;
- $chunk = "hello world2!\n\n" if $counter == 2;
- $counter++;
- return $chunk;
- });
+ $message = $message->body(sub {...});
Helper for simplified content access.
@@ -789,9 +819,11 @@ Access message cookies.
=head2 C<dom>
- my $dom = $message->dom;
+ my $dom = $message->dom;
+ my $collection = $message->dom('a[href]');
-Parses content into a L<Mojo::DOM> object.
+Parses content into a L<Mojo::DOM> object and takes an optional selector to
+perform a find on it right away.
Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<error>
@@ -803,6 +835,13 @@ Note that this method is EXPERIMENTAL and might change without warning!
Parser errors and codes.
+=head2 C<finish>
+
+ $message->finish;
+
+Finish dynamic content generation.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<fix_headers>
$message = $message->fix_headers;
@@ -858,6 +897,13 @@ Check if message content is chunked.
Check if parser is done.
+=head2 C<is_limit_exceeded>
+
+ my $limit = $message->is_limit_exceeded;
+
+Check if message has exceeded C<max_line_size> or C<max_message_size>.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<is_multipart>
my $multipart = $message->is_multipart;
@@ -924,6 +970,24 @@ All file uploads.
HTTP version of message.
+=head2 C<write>
+
+ $message->write('Hello!');
+ $message->write('Hello!', sub {...});
+
+Write dynamic content, the optional drain callback will be invoked once all
+data has been written.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<write_chunk>
+
+ $message->write_chunk('Hello!');
+ $message->write_chunk('Hello!', sub {...});
+
+Write chunked content, the optional drain callback will be invoked once all
+data has been written.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
@@ -100,15 +100,15 @@ sub parse {
# Detect query string without key/value pairs
if ($string !~ /\=/) {
- $string =~ s/\+/\ /g;
- # Unescape
- $string = b($string)->url_unescape->to_string;
+ # Replace "+" with whitespace
+ $string =~ s/\+/\ /g;
- # Try to decode
- if ($charset) {
+ # Escaped string
+ if (index($string, '%') >= 0) {
+ $string = b($string)->url_unescape->to_string;
my $backup = $string;
- $string = b($string)->decode($charset)->to_string;
+ $string = b($string)->decode($charset)->to_string if $charset;
$string = $backup unless defined $string;
}
@@ -126,23 +126,27 @@ sub parse {
$pair =~ /^([^\=]*)(?:=(.*))?$/;
my $name = $1;
my $value = $2;
+ $name = '' unless defined $name;
+ $value = '' unless defined $name;
# Replace "+" with whitespace
- $name =~ s/\+/\ /g if $name;
- $value =~ s/\+/\ /g if $value;
-
- # Unescape
- $name = b($name)->url_unescape->to_string;
- $value = b($value)->url_unescape->to_string;
-
- # Try to decode
- if ($charset) {
- my $nbackup = $name;
- my $vbackup = $value;
- $name = b($name)->decode($charset)->to_string;
- $value = b($value)->decode($charset)->to_string;
- $name = $nbackup unless defined $name;
- $value = $vbackup unless defined $value;
+ $name =~ s/\+/\ /g;
+ $value =~ s/\+/\ /g;
+
+ # Escaped name
+ if (index($name, '%') >= 0) {
+ $name = b($name)->url_unescape->to_string;
+ my $backup = $name;
+ $name = b($name)->decode($charset)->to_string if $charset;
+ $name = $backup unless defined $name;
+ }
+
+ # Escaped value
+ if (index($value, '%') >= 0) {
+ $value = b($value)->url_unescape->to_string;
+ my $backup = $value;
+ $value = b($value)->decode($charset)->to_string if $charset;
+ $value = $backup unless defined $value;
}
push @{$self->params}, $name, $value;
@@ -87,8 +87,11 @@ sub parse {
my @parts;
for my $part (split '/', $path) {
- # Garbage
- next unless length $part;
+ # Empty parts before the first are garbage
+ next unless length $part or scalar @parts;
+
+ # Empty parts behind the first are ok
+ $part = '' unless defined $part;
# Store
push @parts, b($part)->url_unescape($Mojo::URL::PCHAR)->to_string;
@@ -14,7 +14,7 @@ __PACKAGE__->attr(nph => 0);
sub run {
my $self = shift;
- my $tx = $self->build_tx_cb->($self);
+ my $tx = $self->on_build_tx->($self);
my $req = $tx->req;
# Environment
@@ -32,7 +32,7 @@ sub run {
}
# Handle
- $self->handler_cb->($self, $tx);
+ $self->on_handler->($self, $tx);
my $res = $tx->res;
@@ -108,7 +108,7 @@ sub run {
}
# Finish transaction
- $tx->finished->($tx);
+ $tx->on_finish->($tx);
return $res->code;
}
@@ -1,494 +0,0 @@
-package Mojo::Server::Daemon::Prefork;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Server::Daemon';
-
-use Carp 'croak';
-use Fcntl ':flock';
-use File::Spec;
-use IO::File;
-use IO::Poll 'POLLIN';
-use IO::Socket;
-use Mojo::Command;
-use POSIX qw/setsid WNOHANG/;
-
-use constant DEBUG => $ENV{MOJO_SERVER_DEBUG} || 0;
-
-__PACKAGE__->attr(cleanup_interval => 15);
-__PACKAGE__->attr(idle_timeout => 30);
-__PACKAGE__->attr(
- lock_file => sub {
- my $self = shift;
- return File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
- Mojo::Command->class_to_file(ref $self->app) . ".$$.lock");
- }
-);
-__PACKAGE__->attr(max_clients => 1);
-__PACKAGE__->attr(max_requests => 1000);
-__PACKAGE__->attr(max_servers => 100);
-__PACKAGE__->attr(max_spare_servers => 10);
-__PACKAGE__->attr([qw/min_spare_servers start_servers/] => 5);
-
-use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 262144;
-
-# Marge? Since I'm not talking to Lisa,
-# would you please ask her to pass me the syrup?
-# Dear, please pass your father the syrup, Lisa.
-# Bart, tell Dad I will only pass the syrup if it won't be used on any meat
-# product.
-# You dunkin' your sausages in that syrup homeboy?
-# Marge, tell Bart I just want to drink a nice glass of syrup like I do every
-# morning.
-# Tell him yourself, you're ignoring Lisa, not Bart.
-# Bart, thank your mother for pointing that out.
-# Homer, you're not not-talking to me and secondly I heard what you said.
-# Lisa, tell your mother to get off my case.
-# Uhhh, dad, Lisa's the one you're not talking to.
-# Bart, go to your room.
-sub child { shift->ioloop->start }
-
-sub child_status {
- my ($self, $status) = @_;
- $self->{_child_write}->syswrite("$$ $status\n")
- or croak "Can't write to parent: $!";
-}
-
-sub daemonize {
- my $self = shift;
-
- # Fork and kill parent
- croak "Can't fork: $!" unless defined(my $child = fork);
- exit 0 if $child;
- setsid() or croak "Can't start a new session: $!";
-
- # Close file handles
- open STDIN, '</dev/null';
- open STDOUT, '>/dev/null';
- open STDERR, '>&STDOUT';
-
- # Change paths
- chdir '/';
- umask(0);
- $ENV{PATH} = '/bin:/sbin:/usr/bin:/usr/sbin';
-
- return $$;
-}
-
-sub parent {
- my $self = shift;
-
- # Prepare ioloop
- $self->prepare_ioloop;
-}
-
-sub run {
- my $self = shift;
-
- # PID file
- $self->prepare_pid_file;
-
- # Generate lock file name
- $self->lock_file;
-
- # No windows support
- die "Prefork daemon not available for Windows.\n" if $^O eq 'MSWin32';
-
- # Pipe for child communication
- pipe($self->{_child_read}, $self->{_child_write})
- or croak "Can't create pipe: $!";
- $self->{_child_poll} = IO::Poll->new;
- $self->{_child_poll}->mask($self->{_child_read}, POLLIN);
-
- # Parent signals
- my ($done, $graceful) = 0;
- $SIG{INT} = $SIG{TERM} = sub { $done++ };
- $SIG{CHLD} = sub { $self->_reap_child };
- $SIG{USR1} = sub { $done = $graceful = 1 };
-
- # Preload application
- $self->app;
-
- # Parent stuff
- $self->parent;
-
- $self->app->log->debug('Prefork parent started.') if DEBUG;
-
- # Prefork
- $self->_spawn_child for (1 .. $self->start_servers);
-
- # We try to make spawning and killing as smooth as possible
- $self->{_cleanup} = time + $self->cleanup_interval;
- $self->{_spawn} = 1;
-
- # Mainloop
- while (!$done) {
- $self->_read_messages;
- $self->_manage_children;
- }
-
- # Kill em all
- $self->_kill_children($graceful);
- exit 0;
-}
-
-sub _cleanup_children {
- my $self = shift;
- my $children = $self->{_children} || {};
- for my $pid (keys %$children) {
- delete $self->{_children}->{$pid} unless kill 0, $pid;
- }
-}
-
-sub _kill_children {
- my ($self, $graceful) = @_;
-
- # Close pipe
- $self->{_child_read} = undef;
-
- # Kill all children
- my $children = $self->{_children} || {};
- while (%$children) {
-
- # Die die die
- for my $pid (keys %$children) {
- $self->app->log->debug("Killing prefork child $pid.") if DEBUG;
- kill $graceful ? 'HUP' : 'TERM', $pid;
- }
-
- # Cleanup
- $self->_cleanup_children;
-
- # Wait
- sleep 1;
- }
-
- # Remove PID file
- unlink $self->pid_file;
-}
-
-sub _manage_children {
- my $self = shift;
-
- # Make sure we have enough idle processes
- my $children = $self->{_children} || {};
- my @idle = sort { $a <=> $b }
- grep { ($children->{$_}->{state} || '') eq 'idle' }
- keys %$children;
-
- # Debug
- if (DEBUG) {
- my $idle = @idle;
- my $total = keys %$children;
- my $spawn = $self->{_spawn};
- $self->app->log->debug(
- "$idle of $total children idle, 1 listen (spawn $spawn).");
- }
-
- # Need more children
- if (@idle < $self->min_spare_servers) {
- for (1 .. $self->{_spawn}) {
- last if $self->max_servers <= keys %$children;
- $self->_spawn_child;
- }
-
- # Spawn counter
- $self->{_spawn} = $self->{_spawn} * 2;
- $self->{_spawn} = 8 if $self->{_spawn} > 8;
- }
-
- # Too many children
- elsif ((@idle > $self->max_spare_servers)) {
-
- # Kill one at a time
- my $timeout = time - $self->idle_timeout;
- for my $idle (@idle) {
- next unless $timeout > $children->{$idle}->{time};
- kill 'HUP', $idle;
- $self->app->log->debug("Prefork child $idle stopped.") if DEBUG;
-
- # Spawn counter
- $self->{_spawn} = $self->{_spawn} / 2 if $self->{_spawn} >= 2;
-
- last;
- }
- }
-
- # Remove dead child processes every 30 seconds
- if (time > $self->{_cleanup}) {
- $self->_cleanup_children;
- $self->{_cleanup} = time + $self->cleanup_interval;
- }
-}
-
-sub _prepare_lock_file {
- my $self = shift;
-
- # Shortcut
- return unless my $file = $self->lock_file;
-
- # Create lock file
- my $fh = IO::File->new("> $file")
- or croak qq/Can't open lock file "$file"/;
- $self->{_lock} = $fh;
-
- # Lock callback
- my $loop = $self->ioloop;
- $loop->lock_cb(
- sub {
- my $blocking = $_[1];
-
- # Idle
- $self->child_status('idle') if $blocking;
-
- # Lock
- my $flags = $blocking ? LOCK_EX : LOCK_EX | LOCK_NB;
- my $lock = flock($self->{_lock}, $flags);
-
- # Busy
- $self->child_status('busy') if $lock;
-
- return $lock;
- }
- );
-
- # Unlock callback
- $loop->unlock_cb(sub { flock($self->{_lock}, LOCK_UN) });
-}
-
-sub _read_messages {
- my $self = shift;
-
- # Read messages
- my $poll = $self->{_child_poll};
- $poll->poll(1);
- my @readers = $poll->handles(POLLIN);
- my $buffer = '';
- if (@readers) {
- return unless $self->{_child_read}->sysread(my $chunk, CHUNK_SIZE);
- $buffer .= $chunk;
- }
-
- # Parse messages
- my $pos = 0;
- while (length $buffer) {
-
- # Full message
- $pos = index $buffer, "\n";
- last if $pos < 0;
-
- # Parse
- my $message = substr $buffer, 0, $pos + 1, '';
- next unless $message =~ /^(\d+)\ (\w+)\n$/;
- my $pid = $1;
- my $state = $2;
-
- # Update status
- if ($state eq 'done') { delete $self->{_children}->{$pid} }
- else {
- $self->{_children}->{$pid} = {
- state => $state,
- time => time
- };
- }
- }
-}
-
-sub _reap_child {
- my $self = shift;
- while ((my $child = waitpid(-1, WNOHANG)) > 0) {
- $self->app->log->debug("Prefork child $child died.") if DEBUG;
- delete $self->{_children}->{$child};
- }
-}
-
-sub _spawn_child {
- my $self = shift;
-
- # Fork
- croak "Can't fork: $!" unless defined(my $child = fork);
-
- # Parent takes care of child
- if ($child) {
- $self->{_children}->{$child} = {state => 'idle', time => time};
- }
-
- # Child
- else {
-
- # Prepare environment
- $self->_prepare_lock_file;
-
- # Signal handlers
- $SIG{HUP} = $SIG{INT} = $SIG{TERM} = sub { exit 0 };
- $SIG{CHLD} = 'DEFAULT';
- }
-
- # Do child stuff
- unless ($child) {
-
- $self->app->log->debug('Prefork child started.') if DEBUG;
-
- # No need for child reader
- close($self->{_child_read});
- delete $self->{_child_poll};
-
- # Parent will send a HUP signal when there are too many children idle
- my $done = 0;
- $SIG{HUP} = sub { $self->ioloop->max_connections(0) };
-
- # User and group
- $self->setuidgid;
-
- # Spin
- while (!$done) {
- $self->child;
- $done++ if $self->ioloop->max_connections <= 0;
- }
-
- # Done
- $self->child_status('done');
- delete $self->{_child_write};
- exit 0;
- }
-
- return $child;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Server::Daemon::Prefork - Preforking HTTP 1.1 And WebSocket Server
-
-=head1 SYNOPSIS
-
- use Mojo::Daemon::Prefork;
-
- my $daemon = Mojo::Daemon::Prefork->new;
- $daemon->port(8080);
- $daemon->run;
-
-=head1 DESCRIPTION
-
-L<Mojo::Server::Daemon::Prefork> is a full featured preforking HTTP 1.1 and
-WebSocket server using a dynamic worker pool with C<IPv6>, C<TLS>,
-C<Bonjour>, C<epoll>, C<kqueue>, hot deployment, UNIX domain socket sharing
-and optional async io support.
-
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::INET6>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Server::Daemon::Prefork> inherits all attributes from
-L<Mojo::Server::Daemon> and implements the following new ones.
-
-=head2 C<cleanup_interval>
-
- my $cleanup_interval = $daemon->cleanup_interval;
- $daemon = $daemon->cleanup_interval(15);
-
-Cleanup interval for workers in seconds, defaults to C<15>.
-
-=head2 C<idle_timeout>
-
- my $idle_timeout = $daemon->idle_timeout;
- $daemon = $daemon->idle_timeout(30);
-
-Timeout for workers to be idle in seconds, defaults to C<30>.
-
-=head2 C<lock_file>
-
- my $lock_file = $daemon->lock_file;
- $daemon = $daemon->lock_file('/tmp/mojo_daemon.lock');
-
-Path to lock file, defaults to a random temporary file.
-
-=head2 C<max_clients>
-
- my $max_clients = $daemon->max_clients;
- $daemon = $daemon->max_clients(1);
-
-Maximum number of parallel client connections handled by worker, defaults to
-C<1>.
-
-=head2 C<max_requests>
-
- my $max_requests = $daemon->max_requests;
- $daemon = $daemon->max_requests(1);
-
-Maximum number of requests a worker process is allowed to handle, defaults to
-C<1000>.
-
-=head2 C<max_servers>
-
- my $max_servers = $daemon->max_servers;
- $daemon = $daemon->max_servers(100);
-
-Maximum number of active workers, defaults to C<100>.
-
-=head2 C<max_spare_servers>
-
- my $max_spare_servers = $daemon->max_spare_servers;
- $daemon = $daemon->max_spare_servers(10);
-
-Maximum number of idle workers, default to C<10>.
-
-=head2 C<min_spare_servers>
-
- my $min_spare_servers = $daemon->min_spare_servers;
- $daemon = $daemon->min_spare_servers(5);
-
-Minimal number of idle workers, defaults to C<5>.
-
-=head2 C<start_servers>
-
- my $start_servers = $daemon->start_servers;
- $daemon = $daemon->start_servers(5);
-
-Number of workers to spawn at server startup, defaults to C<5>.
-
-=head1 METHODS
-
-L<Mojo::Server::Daemon::Prefork> inherits all methods from
-L<Mojo::Server::Daemon> and implements the following new ones.
-
-=head2 C<child>
-
- $daemon->child;
-
-Worker process.
-
-=head2 C<child_status>
-
- $daemon->child_status('idle');
-
-Change status for worker process.
-
-=head2 C<daemonize>
-
- $daemon->daemonize;
-
-Daemonize manager process.
-
-=head2 C<parent>
-
- $daemon->parent;
-
-Manager process.
-
-=head2 C<run>
-
- $daemon->run;
-
-Start server.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -21,20 +21,15 @@ use constant BONJOUR => $ENV{MOJO_NO_BONJOUR}
# Debug
use constant DEBUG => $ENV{MOJO_DAEMON_DEBUG} || 0;
-__PACKAGE__->attr(
- [qw/group listen listen_queue_size max_requests silent user/]);
+__PACKAGE__->attr([qw/group listen listen_queue_size silent user/]);
__PACKAGE__->attr(ioloop => sub { Mojo::IOLoop->singleton });
-__PACKAGE__->attr(keep_alive_timeout => 15);
-__PACKAGE__->attr(max_clients => 1000);
-__PACKAGE__->attr(max_keep_alive_requests => 100);
-__PACKAGE__->attr(
- pid_file => sub {
- my $self = shift;
- return File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
- Mojo::Command->class_to_file(ref $self->app) . '.pid');
- }
-);
-__PACKAGE__->attr(websocket_timeout => 300);
+__PACKAGE__->attr(keep_alive_timeout => 5);
+__PACKAGE__->attr(max_clients => 1000);
+__PACKAGE__->attr(max_requests => 100);
+__PACKAGE__->attr(websocket_timeout => 300);
+
+# DEPRECATED in Comet!
+*max_keep_alive_requests = \&max_requests;
sub DESTROY {
my $self = shift;
@@ -54,11 +49,8 @@ sub DESTROY {
sub prepare_ioloop {
my $self = shift;
- # Signals
+ # Loop
my $loop = $self->ioloop;
- $SIG{HUP} = sub { $loop->stop };
- $SIG{USR1} = sub { $loop->max_connections(0) }
- if $^O ne 'MSWin32';
# Listen
my $listen = $self->listen || 'http://*:3000';
@@ -68,41 +60,6 @@ sub prepare_ioloop {
$loop->max_connections($self->max_clients);
}
-sub prepare_pid_file {
- my $self = shift;
-
- return unless my $file = $self->pid_file;
-
- # PID file
- my $fh;
- if (-e $file) {
- $fh = IO::File->new("< $file")
- or croak qq/Can't open PID file "$file": $!/;
- my $pid = <$fh>;
- warn "Server already running with PID $pid.\n" if kill 0, $pid;
- warn qq/Can't unlink PID file "$file".\n/
- unless -w $file && unlink $file;
- }
-
- # Create new PID file
- $fh = IO::File->new($file, O_WRONLY | O_CREAT | O_EXCL, 0644)
- or croak qq/Can't create PID file "$file"/;
-
- # PID
- print $fh $$;
- close $fh;
-
- # Signals
- $SIG{INT} = $SIG{TERM} = sub {
-
- # Remove PID file
- unlink $self->pid_file;
-
- # Done
- exit 0;
- };
-}
-
# 40 dollars!? This better be the best damn beer ever..
# *drinks beer* You got lucky.
sub run {
@@ -114,8 +71,8 @@ sub run {
# User and group
$self->setuidgid;
- # Prepare PID file
- $self->prepare_pid_file;
+ # Signals
+ $SIG{INT} = $SIG{TERM} = sub { exit 0 };
# Start loop
$self->ioloop->start;
@@ -157,7 +114,7 @@ sub _build_tx {
my ($self, $id, $c) = @_;
# Build transaction
- my $tx = $self->build_tx_cb->($self);
+ my $tx = $self->on_build_tx->($self);
# Identify
$tx->res->headers->server('Mojolicious (Perl)');
@@ -175,45 +132,31 @@ sub _build_tx {
$tx->remote_port($remote->{port});
# TLS
- if ($c->{tls}) {
- my $url = $tx->req->url;
- $url->scheme('https');
- $url->base->scheme('https');
- }
+ $tx->req->url->base->scheme('https') if $c->{tls};
# Weaken
weaken $self;
# Handler callback
- $tx->handler_cb(
+ $tx->on_handler(
sub {
my $tx = shift;
# Handler
- $self->handler_cb->($self, $tx);
+ $self->on_handler->($self, $tx);
# Resume callback
- $tx->resume_cb(sub { $self->_write($id) });
+ $tx->on_resume(sub { $self->_write($id) });
}
);
# Upgrade callback
- $tx->upgrade_cb(sub { $self->_upgrade($id, @_) });
+ $tx->on_upgrade(sub { $self->_upgrade($id, @_) });
# New request on the connection
$c->{requests} ||= 0;
$c->{requests}++;
- # Request limit
- if (my $max = $self->max_requests) {
- $self->{_requests} ||= 0;
- if (++$self->{_requests} >= $max) {
- for my $id (@{$self->{_listen}}) { $loop->drop($id) }
- $self->max_keep_alive_requests(1);
- $self->ioloop->max_connections(0);
- }
- }
-
# Kept alive if we have more than one request on the connection
$tx->kept_alive(1) if $c->{requests} > 1;
@@ -270,7 +213,7 @@ sub _finish {
weaken $self;
# Resume callback
- $ws->resume_cb(sub { $self->_write($id) });
+ $ws->on_resume(sub { $self->_write($id) });
}
# Failed upgrade
@@ -310,7 +253,7 @@ sub _listen {
my $options = {};
# UNIX domain socket
- if ($listen =~ /^file\:\/\/(.+)$/) { $options->{file} = $1 }
+ if ($listen =~ /^file\:\/\/(.+)$/) { unlink $options->{file} = $1 }
# Internet socket
elsif ($listen =~ /^(http(?:s)?)\:\/\/(.+)\:(\d+)(?:\:(.*)\:(.*))?$/) {
@@ -329,7 +272,7 @@ sub _listen {
weaken $self;
# Callbacks
- $options->{accept_cb} = sub {
+ $options->{on_accept} = sub {
my ($loop, $id) = @_;
# Add new connection
@@ -338,9 +281,9 @@ sub _listen {
# Keep alive timeout
$loop->connection_timeout($id => $self->keep_alive_timeout);
};
- $options->{error_cb} = sub { $self->_error(@_) };
- $options->{hup_cb} = sub { $self->_hup(@_) };
- $options->{read_cb} = sub { $self->_read(@_) };
+ $options->{on_error} = sub { $self->_error(@_) };
+ $options->{on_hup} = sub { $self->_hup(@_) };
+ $options->{on_read} = sub { $self->_read(@_) };
# Listen
my $id = $self->ioloop->listen($options);
@@ -386,7 +329,7 @@ sub _read {
# Last keep alive request
$tx->res->headers->connection('Close')
- if ($c->{requests} || 0) >= $self->max_keep_alive_requests;
+ if ($c->{requests} || 0) >= $self->max_requests;
# Finish
if ($tx->is_done) { $self->_finish($id, $tx) }
@@ -405,13 +348,13 @@ sub _upgrade {
my $c = $self->{_cs}->{$id};
# WebSocket handshake handler
- my $ws = $c->{websocket} = $self->websocket_handshake_cb->($self, $tx);
+ my $ws = $c->{websocket} = $self->on_websocket_handshake->($self, $tx);
# Upgrade connection timeout
$self->ioloop->connection_timeout($id, $self->websocket_timeout);
# Not resumable yet
- $ws->resume_cb(sub {1});
+ $ws->on_resume(sub {1});
}
sub _write {
@@ -445,6 +388,9 @@ sub _write {
$cb = undef unless $c->{transaction} || $c->{websocket};
}
+ # Not writing
+ elsif (!$tx->is_writing) { $cb = undef }
+
# Write
$self->ioloop->write($id, $chunk, $cb);
@@ -473,7 +419,7 @@ L<Mojo::Server::Daemon> is a full featured async io HTTP 1.1 and WebSocket
server with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll>, C<kqueue>, hot deployment
and UNIX domain socket sharing support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::INET6>,
+Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
transparently and used if installed.
@@ -501,7 +447,7 @@ Event loop for server IO, defaults to the global L<Mojo::IOLoop> singleton.
my $keep_alive_timeout = $daemon->keep_alive_timeout;
$daemon = $daemon->keep_alive_timeout(15);
-Timeout for keep alive connections in seconds, defaults to C<15>.
+Timeout for keep alive connections in seconds, defaults to C<5>.
=head2 C<listen>
@@ -524,27 +470,12 @@ Listen queue size, defaults to C<SOMAXCONN>.
Maximum number of parallel client connections, defaults to C<1000>.
-=head2 C<max_keep_alive_requests>
-
- my $max_keep_alive_requests = $daemon->max_keep_alive_requests;
- $daemon = $daemon->max_keep_alive_requests(100);
-
-Maximum number of keep alive requests per connection, defaults to C<100>.
-
=head2 C<max_requests>
my $max_requests = $daemon->max_requests;
- $daemon = $daemon->max_requests(1);
-
-Maximum number of requests the daemon is allowed to handle, not used by
-default.
-
-=head2 C<pid_file>
-
- my $pid_file = $daemon->pid_file;
- $daemon = $daemon->pid_file('/tmp/mojo_daemon.pid');
+ $daemon = $daemon->max_requests(100);
-Path to process id file, defaults to a random temporary file.
+Maximum number of keep alive requests per connection, defaults to C<100>.
=head2 C<silent>
@@ -578,12 +509,6 @@ implements the following new ones.
Prepare event loop.
-=head2 C<prepare_pid_file>
-
- $daemon->prepare_pid_file;
-
-Prepare process id file.
-
=head2 C<run>
$daemon->run;
@@ -76,8 +76,6 @@ sub accept_connection {
# Debug
$self->app->log->debug('Accepted FastCGI connection.') if DEBUG;
- # Blocking sucks
- $c->blocking(0);
return $c;
}
@@ -116,7 +114,7 @@ sub read_request {
$self->app->log->debug('Reading FastCGI request.') if DEBUG;
# Transaction
- my $tx = $self->build_tx_cb->($self);
+ my $tx = $self->on_build_tx->($self);
$tx->connection($c);
my $req = $tx->req;
@@ -230,13 +228,13 @@ sub run {
$self->app->log->debug('Handling FastCGI request.') if DEBUG;
# Handle
- $self->handler_cb->($self, $tx);
+ $self->on_handler->($self, $tx);
# Response
$self->write_response($tx);
# Finish transaction
- $tx->finished->($tx);
+ $tx->on_finish->($tx);
}
}
@@ -14,7 +14,7 @@ use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 262144;
sub run {
my ($self, $env) = @_;
- my $tx = $self->build_tx_cb->($self);
+ my $tx = $self->on_build_tx->($self);
my $req = $tx->req;
# Environment
@@ -32,7 +32,7 @@ sub run {
}
# Handle
- $self->handler_cb->($self, $tx);
+ $self->on_handler->($self, $tx);
my $res = $tx->res;
@@ -52,7 +52,7 @@ sub run {
my $body = Mojo::Server::PSGI::_Handle->new(_res => $res);
# Finish transaction
- $tx->finished->($tx);
+ $tx->on_finish->($tx);
return [$status, \@headers, $body];
}
@@ -26,35 +26,54 @@ __PACKAGE__->attr(
__PACKAGE__->attr(app_class =>
sub { ref $ENV{MOJO_APP} || $ENV{MOJO_APP} || 'Mojo::HelloWorld' });
__PACKAGE__->attr(
- build_tx_cb => sub {
+ on_build_tx => sub {
sub {
my $self = shift;
# Reload
- if (my $reload = $self->reload) {
- local $ENV{MOJO_RELOAD} = $reload;
+ if ($self->reload) {
if (my $e = Mojo::Loader->reload) { warn $e }
delete $self->{app};
}
- return $self->app->build_tx_cb->($self->app);
+ return $self->app->on_build_tx->($self->app);
}
}
);
__PACKAGE__->attr(
- handler_cb => sub {
- sub { shift->app->handler(shift) }
+ on_handler => sub {
+ sub {
+
+ # Application
+ my $app = shift->app;
+
+ # Transaction
+ my $tx = shift;
+
+ # Handler
+ $app->handler($tx);
+
+ # Delayed
+ $app->log->debug(
+ 'Waiting for delayed response, forgot to render or resume?')
+ unless $tx->is_writing;
+ }
}
);
-__PACKAGE__->attr(reload => sub { $ENV{MOJO_RELOAD} || 0 });
__PACKAGE__->attr(
- websocket_handshake_cb => sub {
+ on_websocket_handshake => sub {
sub {
my $self = shift;
- return $self->app->websocket_handshake_cb->($self->app, @_);
+ return $self->app->on_websocket_handshake->($self->app, @_);
}
}
);
+__PACKAGE__->attr(reload => sub { $ENV{MOJO_RELOAD} || 0 });
+
+# DEPRECATED in Comet!
+*build_tx_cb = \&on_build_tx;
+*handler_cb = \&on_handler;
+*websocket_handshake_cb = \&on_websocket_handshake;
# Are you saying you're never going to eat any animal again? What about bacon?
# No.
@@ -80,10 +99,10 @@ Mojo::Server - HTTP Server Base Class
my $self = shift;
# Get a transaction
- my $tx = $self->build_tx_cb->($self);
+ my $tx = $self->on_build_tx->($self);
# Call the handler
- $tx = $self->handler_cb->($self);
+ $tx = $self->on_handler->($self);
}
=head1 DESCRIPTION
@@ -109,25 +128,34 @@ Application this server handles, defaults to a L<Mojo::HelloWorld> object.
Class of the application this server handles, defaults to
L<Mojo::HelloWorld>.
-=head2 C<build_tx_cb>
+=head2 C<on_build_tx>
- my $btx = $server->build_tx_cb;
- $server = $server->build_tx_cb(sub {
+ my $btx = $server->on_build_tx;
+ $server = $server->on_build_tx(sub {
my $self = shift;
return Mojo::Transaction::HTTP->new;
});
Transaction builder callback.
-=head2 C<handler_cb>
+=head2 C<on_handler>
- my $handler = $server->handler_cb;
- $server = $server->handler_cb(sub {
+ my $handler = $server->on_handler;
+ $server = $server->on_handler(sub {
my ($self, $tx) = @_;
});
Handler callback.
+=head2 C<on_websocket_handshake>
+
+ my $handshake = $server->on_websocket_handshake;
+ $server = $server->on_websocket_handshake(sub {
+ my ($self, $tx) = @_;
+ });
+
+WebSocket handshake callback.
+
=head2 C<reload>
my $reload = $server->reload;
@@ -135,15 +163,6 @@ Handler callback.
Activate automatic reloading.
-=head2 C<websocket_handshake_cb>
-
- my $handshake = $server->websocket_handshake_cb;
- $server = $server->websocket_handshake_cb(sub {
- my ($self, $tx) = @_;
- });
-
-WebSocket handshake callback.
-
=head1 METHODS
L<Mojo::Server> inherits all methods from L<Mojo::Base> and implements the
@@ -15,8 +15,8 @@ use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 262144;
__PACKAGE__->attr([qw/auto_escape compiled namespace/]);
__PACKAGE__->attr([qw/append code prepend/] => '');
-__PACKAGE__->attr(capture_end => '}');
-__PACKAGE__->attr(capture_start => '{');
+__PACKAGE__->attr(capture_end => 'end');
+__PACKAGE__->attr(capture_start => 'begin');
__PACKAGE__->attr(comment_mark => '#');
__PACKAGE__->attr(encoding => 'UTF-8');
__PACKAGE__->attr(escape_mark => '=');
@@ -30,15 +30,15 @@ __PACKAGE__->attr(trim_mark => '=');
# Helpers
my $HELPERS = <<'EOF';
+use Mojo::ByteStream 'b';
no strict 'refs'; no warnings 'redefine';
sub block;
*block = sub { shift->(@_) };
sub escape;
*escape = sub {
- my $v = shift;
- ref $v && ref $v eq 'Mojo::ByteStream'
- ? "$v"
- : Mojo::ByteStream->new($v)->xml_escape->to_string;
+ ref $_[0] && ref $_[0] eq 'Mojo::ByteStream'
+ ? "$_[0]"
+ : b($_[0])->xml_escape->to_string;
};
use strict; use warnings;
EOF
@@ -124,7 +124,7 @@ sub build {
my $namespace = $self->namespace || ref $self;
$lines[0] ||= '';
$lines[0] =
- "package $namespace; sub { my \$_M = ''; $HELPERS; $prepend; do {"
+ "package $namespace; $HELPERS sub { my \$_M = ''; $prepend; do {"
. $lines[0];
$lines[-1] .= qq/$append; \$_M; } };/;
@@ -190,52 +190,93 @@ sub parse {
my $capture_start = quotemeta $self->capture_start;
my $capture_end = quotemeta $self->capture_end;
+ # DEPRECATED in Comet!
+ # Use "begin" and "end" instead of "{" and "}"
my $mixed_re = qr/
(
- $tag_start$capture_start$expr$escp # Escaped expression (start)
+ $tag_start$expr$escp\s*$capture_end # Escaped expression (end)
|
- $tag_start$expr$escp # Escaped expression
+ $tag_start$expr$escp # Escaped expression
|
- $tag_start$capture_start$expr # Expression (start)
+ $tag_start$expr\s*$capture_end # Expression (end)
|
- $tag_start$expr # Expression
+ $tag_start$expr # Expression
|
- $tag_start$capture_end$cmnt # Comment (end)
+ $tag_start$cmnt\s*$capture_end # Comment (end)
|
- $tag_start$capture_start$cmnt # Comment (start)
+ $tag_start$cmnt\} # DEPRECATED Comment (end)
|
- $tag_start$cmnt # Comment
+ $tag_start$cmnt # Comment
|
- $tag_start$capture_end # Code (end)
+ $tag_start\s*$capture_end # Code (end)
|
- $tag_start$capture_start # Code (start)
+ $tag_start\} # DEPRECATED Code (end)
|
- $tag_start # Code
+ $tag_start # Code
|
- $trim$capture_start$tag_end # Trim end (start)
+ $capture_start\s*$trim$tag_end # Trim end (start)
|
- $trim$tag_end # Trim end
+ \{$trim$tag_end # DEPRECATED Trim end (start)
|
- $capture_start$tag_end # End (start)
+ $trim$tag_end # Trim end
|
- $tag_end # End
+ $capture_start\s*$tag_end # End (start)
+ |
+ \{$tag_end # DEPRECATED End (start)
+ |
+ $tag_end # End
)
/x;
- # Capture regex
- my $token_capture_re =
- qr/^($tag_start|$tag_end)($capture_end|$capture_start)/;
+ # Capture end regex
+ my $capture_end_re = qr/
+ ^(
+ $tag_start # Start
+ )
+ (?:
+ $expr # Expression
+ )?
+ (?:
+ $escp # Escaped expression
+ )?
+ (?:
+ \s*$capture_end # (end)
+ |
+ \} # DEPRECATED (end)
+ )
+ /x;
# Tag end regex
my $end_re = qr/
^(
- $trim$capture_start$tag_end # Trim end (start)
+ (?:
+ $capture_start\s*$trim$tag_end # Trim end (start)
+ |
+ \{$trim$tag_end # DEPRECATED Trim end (start)
+ )
)|(
- $capture_start$tag_end # End (start)
+ (?:
+ $capture_start\s*$tag_end # End (start)
+ |
+ \{$tag_end # DEPRECATED End (start)
+ )
)|(
- $trim$tag_end # Trim end
+ $trim$tag_end # Trim end
)|
- $tag_end # End
+ $tag_end # End
+ $
+ /x;
+
+ # Perl line regex
+ my $line_re = qr/
+ ^
+ (\s*) # Leading whitespace
+ $line_start # Line start
+ ($expr)? # Expression
+ ($escp)? # Escaped expression
+ (\s*$capture_end)? # End
+ ([^\#\>]{1}.*?)? # Code
+ ($capture_start\s*)? # Start
$
/x;
@@ -245,40 +286,35 @@ sub parse {
my @capture_token;
my $trimming = 0;
for my $line (split /\n/, $tmpl) {
- my @capture;
-
- # Perl line with capture end or start
- if ($line =~ /^$line_start($capture_end|$capture_start)/) {
- my $capture = $1;
- $line =~ s/^($line_start)$capture/$1/;
- @capture =
- ("\\$capture" eq $capture_end ? 'cpen' : 'cpst', undef);
- }
- # Perl line with return value that needs to be escaped
- if ($line =~ /^$line_start$expr$escp(.+)?$/) {
- push @{$self->tree}, [@capture, 'escp', $1];
- $multiline_expression = 0;
- next;
- }
+ # Perl line
+ if ($line =~ /$line_re/) {
- # Perl line with return value
- if ($line =~ /^$line_start$expr(.+)?$/) {
- push @{$self->tree}, [@capture, 'expr', $1];
- $multiline_expression = 0;
- next;
- }
+ # Token
+ my @token = ();
- # Comment line, dummy token needed for line count
- if ($line =~ /^$line_start$cmnt(.+)?$/) {
- push @{$self->tree}, [@capture];
+ # Capture end
+ push @token, 'cpen', undef if $4;
+
+ # Capture start
+ push @token, 'cpst', undef if $6;
+
+ # Expression
+ if ($2) {
+ unshift @token, 'text', $1;
+ push @token, $3 ? 'escp' : 'expr', $5, 'text', "\n";
+ }
+
+ # Code
+ else { push @token, 'code', $5 }
+
+ push @{$self->tree}, \@token;
$multiline_expression = 0;
next;
}
- # Perl line without return value
- if ($line =~ /^$line_start([^\>]{1}.*)?$/) {
- push @{$self->tree}, [@capture, 'code', $1];
+ # Comment line, dummy token needed for line count
+ if ($line =~ /^\s*$line_start$cmnt(.+)?$/) {
$multiline_expression = 0;
next;
}
@@ -309,14 +345,9 @@ sub parse {
# Done trimming
$trimming = 0 if $trimming && $state ne 'text';
- # Perl token with capture end or start
- if ($token =~ /$token_capture_re/) {
- my $tag = quotemeta $1;
- my $capture = quotemeta $2;
- $token =~ s/^($tag)$capture/$1/;
- @capture_token =
- ($capture eq $capture_end ? 'cpen' : 'cpst', undef);
- }
+ # Capture end
+ @capture_token = ('cpen', undef)
+ if $token =~ s/$capture_end_re/$1/;
# End
if ($state ne 'text' && $token =~ /$end_re/) {
@@ -569,23 +600,29 @@ example.
%== Perl expression line, replaced with result
L<Mojo::ByteStream> objects are always excluded from automatic escaping.
+
+ <%= b('<div>excluded!</div>') %>
+
Whitespace characters around tags can be trimmed with a special tag ending.
<%= All whitespace characters around this expression will be trimmed =%>
-You can capture whole template blocks for reuse later.
+You can capture whole template blocks for reuse later with the C<begin> and
+C<end> keywords.
- <% my $block = {%>
+ <% my $block = begin %>
<% my $name = shift; =%>
Hello <%= $name %>.
- <%}%>
- <%= $block->('Sebastian') %>
- <%= $block->('Sara') %>
-
- %{ my $block =
- % my $name = shift;
- Hello <%= $name %>.
- %}
+ <% end %>
+ <%= $block->('Baerbel') %>
+ <%= $block->('Wolfgang') %>
+
+Perl lines can also be indented freely.
+
+ % my $block = begin
+ % my $name = shift;
+ Hello <%= $name %>.
+ % end
%= $block->('Baerbel')
%= $block->('Wolfgang')
@@ -673,24 +710,24 @@ Append Perl code to compiled template.
=head2 C<capture_end>
my $capture_end = $mt->capture_end;
- $mt = $mt->capture_end('}');
+ $mt = $mt->capture_end('end');
-Character indicating the end of a capture block, defaults to C<}>.
+Keyword indicating the end of a capture block, defaults to C<end>.
- %{ $block =
+ <% my $block = begin %>
Some data!
- %}
+ <% end %>
=head2 C<capture_start>
my $capture_start = $mt->capture_start;
- $mt = $mt->capture_start('{');
+ $mt = $mt->capture_start('begin');
-Character indicating the start of a capture block, defaults to C<{>.
+Keyword indicating the start of a capture block, defaults to C<begin>.
- <% my $block = {%>
+ <% my $block = begin %>
Some data!
- <%}%>
+ <% end %>
=head2 C<code>
@@ -8,10 +8,14 @@ use base 'Mojo::Transaction';
use Mojo::Message::Request;
use Mojo::Message::Response;
-__PACKAGE__->attr([qw/handler_cb upgrade_cb/]);
+__PACKAGE__->attr([qw/on_handler on_upgrade/]);
__PACKAGE__->attr(req => sub { Mojo::Message::Request->new });
__PACKAGE__->attr(res => sub { Mojo::Message::Response->new });
+# DEPRECATED in Comet!
+*handler_cb = \&on_handler;
+*upgrade_cb = \&on_upgrade;
+
# What's a wedding? Webster's dictionary describes it as the act of removing
# weeds from one's garden.
sub client_read {
@@ -65,8 +69,8 @@ sub client_write {
my $chunk = '';
# Offsets
- my $offset = $self->{_offset} ||= 0;
- my $write = $self->{_write} ||= 0;
+ $self->{_offset} ||= 0;
+ $self->{_write} ||= 0;
# Request
my $req = $self->req;
@@ -85,59 +89,59 @@ sub client_write {
# Ready for next state
$self->{_state} = 'write_start_line';
- $write = $req->start_line_size;
+ $self->{_write} = $req->start_line_size;
}
# Start line
if ($self->{_state} eq 'write_start_line') {
- my $buffer = $req->get_start_line_chunk($offset);
+ my $buffer = $req->get_start_line_chunk($self->{_offset});
# Written
my $written = defined $buffer ? length $buffer : 0;
- $write = $write - $written;
- $offset = $offset + $written;
+ $self->{_write} = $self->{_write} - $written;
+ $self->{_offset} = $self->{_offset} + $written;
$chunk .= $buffer;
# Done
- if ($write <= 0) {
- $self->{_state} = 'write_headers';
- $offset = 0;
- $write = $req->header_size;
+ if ($self->{_write} <= 0) {
+ $self->{_state} = 'write_headers';
+ $self->{_offset} = 0;
+ $self->{_write} = $req->header_size;
}
}
# Headers
if ($self->{_state} eq 'write_headers') {
- my $buffer = $req->get_header_chunk($offset);
+ my $buffer = $req->get_header_chunk($self->{_offset});
# Written
my $written = defined $buffer ? length $buffer : 0;
- $write = $write - $written;
- $offset = $offset + $written;
+ $self->{_write} = $self->{_write} - $written;
+ $self->{_offset} = $self->{_offset} + $written;
$chunk .= $buffer;
# Done
- if ($write <= 0) {
+ if ($self->{_write} <= 0) {
- $self->{_state} = 'write_body';
- $offset = 0;
- $write = $req->body_size;
+ $self->{_state} = 'write_body';
+ $self->{_offset} = 0;
+ $self->{_write} = $req->body_size;
# Chunked
- $write = 1 if $req->is_chunked;
+ $self->{_write} = 1 if $req->is_chunked;
}
}
# Body
if ($self->{_state} eq 'write_body') {
- my $buffer = $req->get_body_chunk($offset);
+ my $buffer = $req->get_body_chunk($self->{_offset});
# Written
my $written = defined $buffer ? length $buffer : 0;
- $write = $write - $written;
- $offset = $offset + $written;
+ $self->{_write} = $self->{_write} - $written;
+ $self->{_offset} = $self->{_offset} + $written;
$chunk .= $buffer if defined $buffer;
@@ -146,16 +150,12 @@ sub client_write {
if defined $buffer && !length $buffer;
# Chunked
- $write = 1 if $req->is_chunked;
+ $self->{_write} = 1 if $req->is_chunked;
# Done
- $self->{_state} = 'read_response' if $write <= 0;
+ $self->{_state} = 'read_response' if $self->{_write} <= 0;
}
- # Offsets
- $self->{_offset} = $offset;
- $self->{_write} = $write;
-
return $chunk;
}
@@ -230,11 +230,8 @@ sub server_read {
my $handled = $self->{_handled};
if ($req->error && !$handled) {
- # Write
- $self->{_state} = 'write';
-
# Handler callback
- $self->handler_cb->($self);
+ $self->on_handler->($self);
# Close connection
$res->headers->connection('Close');
@@ -246,15 +243,12 @@ sub server_read {
# EOF
elsif ((length $chunk == 0) || ($req->is_done && !$handled)) {
- # Writing
- $self->{_state} = 'write';
-
# Upgrade callback
my $ws;
- $ws = $self->upgrade_cb->($self) if $req->headers->upgrade;
+ $ws = $self->on_upgrade->($self) if $req->headers->upgrade;
# Handler callback
- $self->handler_cb->($ws ? ($ws, $self) : $self);
+ $self->on_handler->($ws ? ($ws, $self) : $self);
# Protect handler from incoming pipelined requests
$self->{_handled} = 1;
@@ -286,8 +280,8 @@ sub server_write {
return $chunk unless $self->{_state};
# Offsets
- my $offset = $self->{_offset} ||= 0;
- my $write = $self->{_write} ||= 0;
+ $self->{_offset} ||= 0;
+ $self->{_write} ||= 0;
# Request and response
my $req = $self->req;
@@ -305,43 +299,43 @@ sub server_write {
# Ready for next state
$self->{_state} = 'write_start_line';
- $write = $res->start_line_size;
+ $self->{_write} = $res->start_line_size;
}
# Start line
if ($self->{_state} eq 'write_start_line') {
- my $buffer = $res->get_start_line_chunk($offset);
+ my $buffer = $res->get_start_line_chunk($self->{_offset});
# Written
my $written = defined $buffer ? length $buffer : 0;
- $write = $write - $written;
- $offset = $offset + $written;
+ $self->{_write} = $self->{_write} - $written;
+ $self->{_offset} = $self->{_offset} + $written;
# Append
$chunk .= $buffer;
# Done
- if ($write <= 0) {
- $self->{_state} = 'write_headers';
- $offset = 0;
- $write = $res->header_size;
+ if ($self->{_write} <= 0) {
+ $self->{_state} = 'write_headers';
+ $self->{_offset} = 0;
+ $self->{_write} = $res->header_size;
}
}
# Headers
if ($self->{_state} eq 'write_headers') {
- my $buffer = $res->get_header_chunk($offset);
+ my $buffer = $res->get_header_chunk($self->{_offset});
# Written
my $written = defined $buffer ? length $buffer : 0;
- $write = $write - $written;
- $offset = $offset + $written;
+ $self->{_write} = $self->{_write} - $written;
+ $self->{_offset} = $self->{_offset} + $written;
# Append
$chunk .= $buffer;
# Done
- if ($write <= 0) {
+ if ($self->{_write} <= 0) {
# HEAD request
if ($req->method eq 'HEAD') {
@@ -352,12 +346,12 @@ sub server_write {
# Body
else {
- $self->{_state} = 'write_body';
- $offset = 0;
- $write = $res->body_size;
+ $self->{_state} = 'write_body';
+ $self->{_offset} = 0;
+ $self->{_write} = $res->body_size;
# Chunked
- $write = 1 if $res->is_chunked;
+ $self->{_write} = 1 if $res->is_chunked;
}
}
}
@@ -366,7 +360,7 @@ sub server_write {
if ($self->{_state} eq 'write_body') {
# 100 Continue
- if ($write <= 0) {
+ if ($self->{_write} <= 0) {
# Continue done
if (defined $self->{_continued} && $self->{_continued} == 0) {
@@ -379,34 +373,39 @@ sub server_write {
# Everything done
elsif (!defined $self->{_continued}) { $self->{_state} = 'done' }
-
}
# Normal body
else {
- my $buffer = $res->get_body_chunk($offset);
+ my $buffer = $res->get_body_chunk($self->{_offset});
# Written
my $written = defined $buffer ? length $buffer : 0;
- $write = $write - $written;
- $offset = $offset + $written;
+ $self->{_write} = $self->{_write} - $written;
+ $self->{_offset} = $self->{_offset} + $written;
# Append
- $chunk .= $buffer;
+ if (defined $buffer) {
+ $chunk .= $buffer;
+ delete $self->{_delay};
+ }
+
+ # Delayed
+ else {
+ my $delay = delete $self->{_delay};
+ $self->{_state} = 'paused' if $delay;
+ $self->{_delay} = 1 unless $delay;
+ }
# Chunked
- $write = 1 if $res->is_chunked;
+ $self->{_write} = 1 if $res->is_chunked;
# Done
$self->{_state} = 'done'
- if $write <= 0 || (defined $buffer && !length $buffer);
+ if $self->{_write} <= 0 || (defined $buffer && !length $buffer);
}
}
- # Offsets
- $self->{_offset} = $offset;
- $self->{_write} = $write;
-
return $chunk;
}
@@ -438,13 +437,6 @@ described in RFC 2616.
L<Mojo::Transaction::HTTP> inherits all attributes from L<Mojo::Transaction>
and implements the following new ones.
-=head2 C<handler_cb>
-
- my $cb = $tx->handler_cb;
- $tx = $tx->handler_cb(sub {...});
-
-Handler callback.
-
=head2 C<keep_alive>
my $keep_alive = $tx->keep_alive;
@@ -452,26 +444,33 @@ Handler callback.
Connection can be kept alive.
+=head2 C<on_handler>
+
+ my $cb = $tx->on_handler;
+ $tx = $tx->on_handler(sub {...});
+
+Handler callback.
+
+=head2 C<on_upgrade>
+
+ my $cb = $tx->on_upgrade;
+ $tx = $tx->on_upgrade(sub {...});
+
+WebSocket upgrade callback.
+
=head2 C<req>
my $req = $tx->req;
$tx = $tx->req(Mojo::Message::Request->new);
-HTTP 1.1 request.
+HTTP 1.1 request, by default a L<Mojo::Message::Request> object.
=head2 C<res>
my $res = $tx->res;
$tx = $tx->res(Mojo::Message::Response->new);
-HTTP 1.1 response.
-
-=head2 C<upgrade_cb>
-
- my $cb = $tx->upgrade_cb;
- $tx = $tx->upgrade_cb(sub {...});
-
-WebSocket upgrade callback.
+HTTP 1.1 response, by default a L<Mojo::Message::Response> object.
=head1 METHODS
@@ -1,40 +0,0 @@
-package Mojo::Transaction::Single;
-
-use strict;
-use warnings;
-
-# DEPRECATED in Snowman!
-# Use Mojo::Transaction::HTTP instead.
-use base 'Mojo::Transaction::HTTP';
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Transaction::Single - DEPRECATED!
-
-=head1 SYNOPSIS
-
- # This module is deprecated, use Mojo::Transaction::HTTP instead
-
-=head1 DESCRIPTION
-
-L<Mojo::Transaction::Single> is deprecated, use L<Mojo::Transaction::HTTP>
-instead.
-
-=head1 ATTRIBUTES
-
-L<Mojo::Transaction::Single> inherits all attributes from
-L<Mojo::Transaction::HTTP>.
-
-=head1 METHODS
-
-L<Mojo::Transaction::Single> inherits all methods from
-L<Mojo::Transaction::HTTP>.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -10,12 +10,15 @@ use base 'Mojo::Transaction';
use Mojo::ByteStream 'b';
use Mojo::Transaction::HTTP;
+__PACKAGE__->attr(handshake => sub { Mojo::Transaction::HTTP->new });
__PACKAGE__->attr(
- receive_message => sub {
+ on_message => sub {
sub { }
}
);
-__PACKAGE__->attr(handshake => sub { Mojo::Transaction::HTTP->new });
+
+# DEPRECATED in Comet!
+*receive_message = \&on_message;
sub client_challenge {
my $self = shift;
@@ -27,8 +30,8 @@ sub client_challenge {
my $headers = $self->req->headers;
# WebSocket challenge
- my $solution = $self->_challenge(scalar $headers->sec_websocket_key1,
- scalar $headers->sec_websocket_key2, $req->body);
+ my $solution = $self->_challenge($headers->sec_websocket_key1,
+ $headers->sec_websocket_key2, $req->body);
return unless $solution eq $self->res->body;
return 1;
}
@@ -83,6 +86,15 @@ sub remote_port { shift->handshake->remote_port }
sub req { shift->handshake->req(@_) }
sub res { shift->handshake->res(@_) }
+sub resume {
+ my $self = shift;
+
+ # Resume
+ $self->handshake->resume;
+
+ return $self;
+}
+
sub send_message {
my ($self, $message) = @_;
@@ -115,17 +127,16 @@ sub server_handshake {
$res->code(101);
$rsh->upgrade('WebSocket');
$rsh->connection('Upgrade');
- my $scheme = $url->to_abs->scheme eq 'https' ? 'wss' : 'ws';
+ my $scheme = $url->to_abs->scheme eq 'https' ? 'wss' : 'ws';
my $location = $url->to_abs->scheme($scheme)->to_string;
- my $origin = $rqh->origin;
- $rsh->sec_websocket_origin($origin);
$rsh->sec_websocket_location($location);
- $rsh->sec_websocket_protocol($rqh->sec_websocket_protocol);
+ my $origin = $rqh->origin;
+ $rsh->sec_websocket_origin($origin) if $origin;
+ my $protocol = $rqh->sec_websocket_protocol;
+ $rsh->sec_websocket_protocol($protocol) if $protocol;
$res->body(
$self->_challenge(
- scalar $rqh->sec_websocket_key1,
- scalar $rqh->sec_websocket_key2,
- $req->body
+ $rqh->sec_websocket_key1, $rqh->sec_websocket_key2, $req->body
)
);
@@ -137,7 +148,7 @@ sub server_read {
my ($self, $chunk) = @_;
# Add chunk
- my $buffer = $self->{_read} ||= Mojo::ByteStream->new;
+ my $buffer = $self->{_read} ||= b();
$buffer->add_chunk($chunk);
# Full frames
@@ -154,13 +165,11 @@ sub server_read {
$message =~ s/[\xff]$//;
# Callback
- $self->receive_message->(
- $self, b($message)->decode('UTF-8')->to_string
- );
+ $self->on_message->($self, b($message)->decode('UTF-8')->to_string);
}
# Resume
- $self->resume_cb->($self);
+ $self->on_resume->($self);
return $self;
}
@@ -169,7 +178,7 @@ sub server_write {
my $self = shift;
# Not writing anymore
- my $write = $self->{_write} ||= Mojo::ByteStream->new;
+ my $write = $self->{_write} ||= b();
unless ($write->size) {
$self->{_state} = $self->{_finished} ? 'done' : 'read';
}
@@ -219,14 +228,14 @@ sub _send_bytes {
my ($self, $bytes) = @_;
# Add to buffer
- my $write = $self->{_write} ||= Mojo::ByteStream->new;
+ my $write = $self->{_write} ||= b();
$write->add_chunk($bytes);
# Writing
$self->{_state} = 'write';
# Resume
- $self->resume_cb->($self);
+ $self->on_resume->($self);
}
1;
@@ -257,14 +266,14 @@ L<Mojo::Transaction> and implements the following new ones.
The original handshake transaction.
-=head2 C<receive_message>
+=head2 C<on_message>
- my $cb = $ws->receive_message;
- $ws = $ws->receive_message(sub {...});
+ my $cb = $ws->on_message;
+ $ws = $ws->on_message(sub {...});
The callback that receives decoded messages one by one.
- $ws->receive_message(sub {
+ $ws->on_message(sub {
my ($self, $message) = @_;
});
@@ -359,6 +368,12 @@ The original handshake request.
The original handshake response.
+=head2 C<resume>
+
+ $ws = $ws->resume;
+
+Resume transaction.
+
=head2 C<send_message>
$ws->send_message('Hi there!');
@@ -10,12 +10,16 @@ use Carp 'croak';
__PACKAGE__->attr([qw/connection kept_alive local_address local_port/]);
__PACKAGE__->attr([qw/previous remote_port/]);
__PACKAGE__->attr(
- [qw/finished resume_cb/] => sub {
+ [qw/on_finish on_resume/] => sub {
sub {1}
}
);
__PACKAGE__->attr(keep_alive => 0);
+# DEPRECATED in Comet!
+*finished = \&on_finish;
+*resume_cb = \&on_resume;
+
# Please don't eat me! I have a wife and kids. Eat them!
sub client_read { croak 'Method "client_read" not implemented by subclass' }
sub client_write { croak 'Method "client_write" not implemented by subclass' }
@@ -34,11 +38,6 @@ sub is_done {
return;
}
-sub is_paused {
- return 1 if (shift->{_state} || '') eq 'paused';
- return;
-}
-
sub is_websocket {0}
sub is_writing {
@@ -51,21 +50,6 @@ sub is_writing {
return;
}
-sub pause {
- my $self = shift;
-
- # Already paused
- return $self if $self->{_real_state};
-
- # Save state
- $self->{_real_state} = $self->{_state};
-
- # Pause
- $self->{_state} = 'paused';
-
- return $self;
-}
-
sub remote_address {
my ($self, $address) = @_;
@@ -107,14 +91,16 @@ sub res { croak 'Method "res" not implemented by subclass' }
sub resume {
my $self = shift;
- # Not paused
- return unless $self->{_real_state};
+ # Delayed
+ if (($self->{_state} || '') eq 'paused') {
+ $self->{_state} = 'write_body';
+ }
- # Resume
- $self->{_state} = delete $self->{_real_state};
+ # Writing
+ elsif (!$self->is_writing) { $self->{_state} = 'write' }
# Callback
- $self->resume_cb->($self);
+ $self->on_resume->($self);
return $self;
}
@@ -123,7 +109,7 @@ sub server_close {
my $self = shift;
# Transaction finished
- $self->finished->($self);
+ $self->on_finish->($self);
return $self;
}
@@ -163,17 +149,6 @@ L<Mojo::Transaction> implements the following attributes.
Connection identifier or socket.
-=head2 C<finished>
-
- my $cb = $tx->finished;
- $tx = $tx->finished(sub {...});
-
-Callback signaling that the transaction has been finished.
-
- $tx->finsihed(sub {
- my $self = shift;
- });
-
=head2 C<keep_alive>
my $keep_alive = $tx->keep_alive;
@@ -202,6 +177,24 @@ Local interface address.
Local interface port.
+=head2 C<on_finish>
+
+ my $cb = $tx->on_finish;
+ $tx = $tx->on_finish(sub {...});
+
+Callback signaling that the transaction has been finished.
+
+ $tx->on_finish(sub {
+ my $self = shift;
+ });
+
+=head2 C<on_resume>
+
+ my $cb = $tx->on_resume;
+ $tx = $tx->on_resume(sub {...});
+
+Callback to be invoked whenever the transaction is resumed.
+
=head2 C<previous>
my $previous = $tx->previous;
@@ -223,13 +216,6 @@ Remote interface address.
Remote interface port.
-=head2 C<resume_cb>
-
- my $cb = $tx->resume_cb;
- $tx = $tx->resume_cb(sub {...});
-
-Callback to be invoked whenever the transaction is resumed.
-
=head1 METHODS
L<Mojo::Transaction> inherits all methods from L<Mojo::Base> and implements
@@ -260,12 +246,6 @@ Parser errors and codes.
Check if transaction is done.
-=head2 C<is_paused>
-
- my $paused = $tx->is_paused;
-
-Check if transaction is paused.
-
=head2 C<is_websocket>
my $is_websocket = $tx->is_websocket;
@@ -278,23 +258,17 @@ Check if transaction is a WebSocket.
Check if transaction is writing.
-=head2 C<pause>
-
- $tx = $tx->pause;
-
-Pause transaction, it can still read but writing is disabled while paused.
-
=head2 C<req>
my $req = $tx->req;
-Transaction request.
+Transaction request, usually a L<Mojo::Message::Request> object.
=head2 C<res>
my $res = $tx->res;
-Transaction response.
+Transaction response, usually a L<Mojo::Message::Response> object.
=head2 C<resume>
@@ -13,14 +13,33 @@ use Mojo::Path;
__PACKAGE__->attr([qw/fragment host port scheme userinfo/]);
__PACKAGE__->attr(base => sub { Mojo::URL->new });
-# RFC 3986
+# Characters (RFC 3986)
our $UNRESERVED = 'A-Za-z0-9\-\.\_\~';
our $SUBDELIM = '!\$\&\'\(\)\*\+\,\;\=';
our $PCHAR = "$UNRESERVED$SUBDELIM\%\:\@";
-# The specs for this are blurry, it's mostly a colelction of w3c suggestions
+# The specs for this are blurry, it's mostly a collection of w3c suggestions
our $PARAM = "$UNRESERVED\!\$\'\(\)\*\,\:\@\/\?";
+# IPv4 regex (RFC 3986)
+my $DEC_OCTET_RE = qr/(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])/;
+our $IPV4_RE = qr/$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE/;
+
+# IPv6 regex (RFC 3986)
+my $H16_RE = qr/[0-9A-Fa-f]{1,4}/;
+my $LS32_RE = qr/(?:$H16_RE:$H16_RE|$IPV4_RE)/;
+our $IPV6_RE = qr/(?:
+ (?: $H16_RE : ){6} $LS32_RE
+ | :: (?: $H16_RE : ){5} $LS32_RE
+ | (?: $H16_RE )? :: (?: $H16_RE : ){4} $LS32_RE
+ | (?: (?: $H16_RE : ){0,1} $H16_RE )? :: (?: $H16_RE : ){3} $LS32_RE
+ | (?: (?: $H16_RE : ){0,2} $H16_RE )? :: (?: $H16_RE : ){2} $LS32_RE
+ | (?: (?: $H16_RE : ){0,3} $H16_RE )? :: $H16_RE : $LS32_RE
+ | (?: (?: $H16_RE : ){0,4} $H16_RE )? :: $LS32_RE
+ | (?: (?: $H16_RE : ){0,5} $H16_RE )? :: $H16_RE
+ | (?: (?: $H16_RE : ){0,6} $H16_RE )? ::
+)/x;
+
sub new {
my $self = shift->SUPER::new();
$self->parse(@_);
@@ -127,6 +146,16 @@ sub is_abs {
return;
}
+sub is_ipv4 {
+ return 1 if shift->host =~ $IPV4_RE;
+ return;
+}
+
+sub is_ipv6 {
+ return 1 if shift->host =~ $IPV6_RE;
+ return;
+}
+
sub parse {
my ($self, $url) = @_;
@@ -162,6 +191,7 @@ sub path {
else {
my $new = Mojo::Path->new($path);
$path = $self->{path} || Mojo::Path->new;
+ pop @{$path->parts} unless $path->trailing_slash;
push @{$path->parts}, @{$new->parts};
$path->leading_slash(1);
$path->trailing_slash($new->trailing_slash);
@@ -183,12 +213,18 @@ sub query {
# Set
if (@_) {
- # Multiple values
+ # Replace with array
if (@_ > 1 || (ref $_[0] && ref $_[0] eq 'ARRAY')) {
$self->{query} = Mojo::Parameters->new(ref $_[0] ? @{$_[0]} : @_);
}
- # Single value
+ # Append hash
+ elsif (ref $_[0] && ref $_[0] eq 'HASH') {
+ my $q = $self->{query} ||= Mojo::Parameters->new;
+ $q->append(%{$_[0]});
+ }
+
+ # Replace with string or object
else {
$self->{query} =
!ref $_[0] ? Mojo::Parameters->new->append($_[0]) : $_[0];
@@ -411,6 +447,20 @@ Host part of this URL in punycode format.
Check if URL is absolute.
+=head2 C<is_ipv4>
+
+ my $is_ipv4 = $url->is_ipv4;
+
+Check if C<host> is an C<IPv4> address.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<is_ipv6>
+
+ my $is_ipv6 = $url->is_ipv6;
+
+Check if C<host> is an C<IPv6> address.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<parse>
$url = $url->parse('http://127.0.0.1:3000/foo/bar?fo=o&baz=23#foo');
@@ -430,8 +480,9 @@ defaults to a L<Mojo::Path> object.
=head2 C<query>
my $query = $url->query;
- $url = $url->query(name => 'value');
- $url = $url->query([name => 'value']);
+ $url = $url->query(replace => 'with');
+ $url = $url->query([replace => 'with']);
+ $url = $url->query({append => 'to'});
$url = $url->query(Mojo::Parameters->new);
Query part of this URL, defaults to a L<Mojo::Parameters> object.
@@ -13,16 +13,16 @@ use Mojo::Log;
use Mojo::Transaction::HTTP;
use Mojo::Transaction::WebSocket;
+__PACKAGE__->attr(client => sub { Mojo::Client->singleton });
+__PACKAGE__->attr(home => sub { Mojo::Home->new });
+__PACKAGE__->attr(log => sub { Mojo::Log->new });
__PACKAGE__->attr(
- build_tx_cb => sub {
+ on_build_tx => sub {
sub { return Mojo::Transaction::HTTP->new }
}
);
-__PACKAGE__->attr(client => sub { Mojo::Client->singleton });
-__PACKAGE__->attr(home => sub { Mojo::Home->new });
-__PACKAGE__->attr(log => sub { Mojo::Log->new });
__PACKAGE__->attr(
- websocket_handshake_cb => sub {
+ on_websocket_handshake => sub {
sub {
return Mojo::Transaction::WebSocket->new(handshake => pop)
->server_handshake;
@@ -30,9 +30,9 @@ __PACKAGE__->attr(
}
);
-# DEPRECATED in Snowman!
-# Use $Mojolicious::VERSION instead
-our $VERSION = '0.999929';
+# DEPRECATED in Comet!
+*build_tx_cb = \&on_build_tx;
+*websocket_handshake_cb = \&on_websocket_handshake;
# Oh, so they have internet on computers now!
sub new {
@@ -79,7 +79,7 @@ Mojo - The Box!
use base 'Mojo';
- # All the complexities of CGI, FastCGI, PSGI, HTTP and WebSocket get
+ # All the complexities of CGI, FastCGI, PSGI, HTTP and WebSockets get
# reduced to a single method call!
sub handler {
my ($self, $tx) = @_;
@@ -89,8 +89,10 @@ Mojo - The Box!
my $path = $tx->req->url->path;
# Response
+ $tx->res->code(200);
$tx->res->headers->content_type('text/plain');
$tx->res->body("$method request for $path!");
+ $tx->resume;
}
=head1 DESCRIPTION
@@ -105,41 +107,41 @@ See L<Mojolicious> for more!
L<Mojo> implements the following attributes.
-=head2 C<build_tx_cb>
-
- my $cb = $mojo->build_tx_cb;
- $mojo = $mojo->build_tx_cb(sub { ... });
-
-The transaction builder callback, by default it builds a
-L<Mojo::Transaction::HTTP> object.
-
=head2 C<client>
- my $client = $mojo->client;
- $mojo = $mojo->client(Mojo::Client->new);
+ my $client = $app->client;
+ $app = $app->client(Mojo::Client->new);
A full featured HTTP 1.1 client for use in your applications, by default a
L<Mojo::Client> object.
=head2 C<home>
- my $home = $mojo->home;
- $mojo = $mojo->home(Mojo::Home->new);
+ my $home = $app->home;
+ $app = $app->home(Mojo::Home->new);
The home directory of your application, by default a L<Mojo::Home> object
which stringifies to the actual path.
=head2 C<log>
- my $log = $mojo->log;
- $mojo = $mojo->log(Mojo::Log->new);
+ my $log = $app->log;
+ $app = $app->log(Mojo::Log->new);
The logging layer of your application, by default a L<Mojo::Log> object.
-=head2 C<websocket_handshake_cb>
+=head2 C<on_build_tx>
+
+ my $cb = $app->on_build_tx;
+ $app = $app->on_build_tx(sub { ... });
+
+The transaction builder callback, by default it builds a
+L<Mojo::Transaction::HTTP> object.
+
+=head2 C<on_websocket_handshake>
- my $cb = $mojo->websocket_handshake_cb;
- $mojo = $mojo->websocket_handshake_cb(sub { ... });
+ my $cb = $app->on_websocket_handshake;
+ $app = $app->on_websocket_handshake(sub { ... });
The websocket handshake callback, by default it builds a
L<Mojo::Transaction::WebSocket> object and handles the response for the
@@ -152,7 +154,7 @@ new ones.
=head2 C<new>
- my $mojo = Mojo->new;
+ my $app = Mojo->new;
Construct a new L<Mojo> application.
Will automatically detect your home directory and set up logging to
@@ -160,10 +162,11 @@ C<log/mojo.log> if there's a log directory.
=head2 C<handler>
- $tx = $mojo->handler($tx);
+ $tx = $app->handler($tx);
The handler is the main entry point to your application or framework and
-will be called for each new transaction.
+will be called for each new transaction, usually a L<Mojo::Transaction::HTTP>
+or L<Mojo::Transaction::WebSocket> object.
sub handler {
my ($self, $tx) = @_;
@@ -6,12 +6,60 @@ use warnings;
# Scalpel... blood bucket... priest.
use base 'Mojo::Base';
-# If we don't go back there and make that event happen,
-# the entire universe will be destroyed...
-# And as an environmentalist, I'm against that.
+__PACKAGE__->attr('app');
+
+# Reserved stash values
+my $STASH_RE = qr/
+ ^
+ (?:
+ action
+ |
+ app
+ |
+ cb
+ |
+ class
+ |
+ controller
+ |
+ data
+ |
+ exception
+ |
+ extends
+ |
+ format
+ |
+ handler
+ |
+ json
+ |
+ layout
+ |
+ method
+ |
+ namespace
+ |
+ partial
+ |
+ path
+ |
+ status
+ |
+ template
+ |
+ text
+ )
+ $
+ /x;
+
+# I'm immortal.
+# How come you scream so much when you're in danger?
+# I never said I wasn't a drama queen.
sub render_exception { }
sub render_not_found { }
+# All this knowledge is giving me a raging brainer.
sub stash {
my $self = shift;
@@ -27,6 +75,8 @@ sub stash {
# Set
my $values = ref $_[0] ? $_[0] : {@_};
for my $key (keys %$values) {
+ $self->app->log->debug(qq/Careful, "$key" is a reserved stash value./)
+ if $key =~ $STASH_RE;
$self->{stash}->{$key} = $values->{$key};
}
@@ -48,6 +98,15 @@ MojoX::Controller - Controller Base Class
L<MojoX::Controller> is an abstract controllers base class.
+=head1 L<MojoX::Controller> implements the following attributes.
+
+=head2 C<app>
+
+ my $app = $c->app;
+ $c = $c->app(MojoSubclass->new);
+
+A reference back to the application that dispatched to this controller.
+
=head1 METHODS
L<MojoX::Controller> inherits all methods from L<Mojo::Base> and implements
@@ -5,25 +5,19 @@ use warnings;
use base 'MojoX::Session::Cookie::Controller';
-require Carp;
-require Scalar::Util;
-
__PACKAGE__->attr('match');
# Just make a simple cake. And this time, if someone's going to jump out of
# it make sure to put them in *after* you cook it.
sub param {
- my $self = shift;
+ my ($self, $name) = @_;
- # Parameters
- my $params = $self->stash->{'mojo.params'} || $self->req->params;
- Carp::croak(qq/Stash value "params" is not a "Mojo::Parameters" object./)
- unless ref $params
- && Scalar::Util::blessed($params)
- && $params->isa('Mojo::Parameters');
+ # Captures
+ my $p = $self->stash->{'mojo.captures'} || {};
+ return $p->{$name} if exists $p->{$name};
- # Values
- return wantarray ? ($params->param(@_)) : scalar $params->param(@_);
+ # Params
+ return $self->req->param($name);
}
1;
@@ -24,13 +24,20 @@ sub auto_render {
# Transaction
my $tx = $c->tx;
- # Render
- return !$c->render
- unless $c->stash->{'mojo.rendered'}
- || $tx->is_paused
- || $tx->is_websocket;
+ # Rendering
+ my $success = eval {
+
+ # Render
+ $c->render unless $c->stash->{'mojo.rendered'} || $tx->is_websocket;
+
+ # Success
+ 1;
+ };
- # Nothing to render
+ # Renderer error
+ $c->render_exception($@) if !$success && $@;
+
+ # Rendered
return;
}
@@ -78,9 +85,6 @@ sub dispatch {
$res->code($code) if $code;
}
- # Params
- my $p = $c->stash->{'mojo.params'} ||= $c->tx->req->params->clone;
-
# Walk the stack
return 1 if $self->_walk_stack($c);
@@ -130,13 +134,15 @@ sub _dispatch_controller {
# Class
$app ||= $self->_generate_class($c);
- return unless $app;
+ return 1 unless $app;
# Method
my $method = $self->_generate_method($c);
# Debug
- $c->app->log->debug('Dispatching controller.');
+ my $dispatch = ref $app || $app;
+ $dispatch .= "->$method" if $method;
+ $c->app->log->debug("Dispatching $dispatch.");
# Load class
unless (ref $app && $self->{_loaded}->{$app}) {
@@ -145,7 +151,10 @@ sub _dispatch_controller {
if (my $e = Mojo::Loader->load($app)) {
# Doesn't exist
- return unless ref $e;
+ unless (ref $e) {
+ $c->app->log->debug("$app does not exist, maybe a typo?");
+ return;
+ }
# Error
$c->app->log->error($e);
@@ -169,8 +178,9 @@ sub _dispatch_controller {
# Call action
$continue = $app->$method if $app->can($method);
- # Copy stash
- $c->stash($app->stash);
+ # Merge stash
+ my $new = $app->stash;
+ @{$c->stash}{keys %$new} = values %$new;
}
# Handler
@@ -266,15 +276,23 @@ sub _generate_method {
sub _walk_stack {
my ($self, $c) = @_;
+ # Stack
+ my $stack = $c->match->stack;
+
# Walk the stack
- my $staging = $#{$c->match->stack};
- for my $field (@{$c->match->stack}) {
+ my $staging = @$stack;
+ for my $field (@$stack) {
+ $staging--;
+
+ # Stash
+ my $stash = $c->stash;
- # Params
- $c->stash->{'mojo.params'}->append(%{$field});
+ # Captures
+ my $captures = $stash->{'mojo.captures'} ||= {};
+ $stash->{'mojo.captures'} = {%$captures, %$field};
# Merge in captures
- $c->stash({%{$c->stash}, %{$field}});
+ @{$c->stash}{keys %$field} = values %$field;
# Captures
$c->match->captures($field);
@@ -292,7 +310,7 @@ sub _walk_stack {
}
# Break the chain
- return unless $e;
+ return 1 if $staging && !$e;
}
# Done
@@ -43,7 +43,7 @@ sub dispatch {
return 1 if $parts[0] eq '..';
# Serve static file
- return $self->serve($c, File::Spec->catfile(@parts));
+ return $self->serve($c, join('/', @parts));
}
sub serve {
@@ -107,6 +107,9 @@ sub serve {
# Log
$c->app->log->debug(qq/Serving static file "$rel"./);
+ # Resume
+ $c->tx->resume;
+
# Request
my $req = $c->req;
@@ -82,8 +82,7 @@ sub render {
# Arguments
$args ||= {};
- # We got called
- $stash->{'mojo.rendered'} = 1;
+ # Content
my $content = $stash->{'mojo.content'} ||= {};
# Partial
@@ -101,6 +100,9 @@ sub render {
# Template
my $template = delete $stash->{template};
+ # Template class
+ my $class = $stash->{template_class};
+
# Format
my $format = $stash->{format} || $self->default_format;
@@ -116,12 +118,17 @@ sub render {
# Text
my $text = delete $stash->{text};
+ # Inline
+ my $inline = delete $stash->{inline};
+ $handler = $self->default_handler if defined $inline && !defined $handler;
+
my $options = {
template => $template,
format => $format,
handler => $handler,
encoding => $self->encoding,
- template_class => $stash->{template_class}
+ inline => $inline,
+ template_class => $class
};
my $output;
@@ -173,12 +180,19 @@ sub render {
# Extends
while ((my $extends = $self->_extends($c)) && !$json && !$data) {
+ # Stash
+ my $stash = $c->stash;
+
+ # Template class
+ $class = $stash->{template_class};
+ $options->{template_class} = $class;
+
# Handler
- $handler = $c->stash->{handler};
+ $handler = $stash->{handler};
$options->{handler} = $handler;
# Format
- $format = $c->stash->{format} || $self->default_format;
+ $format = $stash->{format} || $self->default_format;
$options->{format} = $format;
# Template
@@ -248,6 +262,7 @@ sub _detect_handler {
# Detect
return unless my $file = $self->template_name($options);
+ $file = quotemeta $file;
for my $template (@$templates, @$inline) {
if ($template =~ /^$file\.(\w+)$/) { return $1 }
}
@@ -255,6 +270,8 @@ sub _detect_handler {
return;
}
+# You are hereby conquered.
+# Please line up in order of how much beryllium it takes to kill you.
sub _detect_template_class {
my ($self, $options) = @_;
return
@@ -348,8 +365,8 @@ The renderer will use L<MojoX::Types> to look up the content MIME type.
my $default = $renderer->default_handler;
$renderer = $renderer->default_handler('epl');
-The default template handler to use for rendering.
-There are two handlers in this distribution.
+The default template handler to use for rendering in cases where auto
+detection doesn't work, like for C<inline> templates.
=over 4
@@ -378,8 +395,6 @@ section.
Template auto detection, the renderer will try to select the right template
and renderer automatically.
-A very powerful alternative to C<default_handler> that allows parallel use of
-multiple template systems.
=head2 C<encoding>
@@ -44,6 +44,15 @@ sub match {
# Root
$self->root($r) unless $self->root;
+ # Path
+ my $path = $self->{_path};
+
+ # Match
+ my $captures = $r->pattern->shape_match(\$path);
+
+ # No match
+ return unless $captures;
+
# Conditions
for (my $i = 0; $i < @{$r->conditions}; $i += 2) {
my $name = $r->conditions->[$i];
@@ -54,25 +63,10 @@ sub match {
return unless $condition;
# Match
- my $captures =
- $condition->($r, $self->{_controller}, $self->captures, $value);
-
- # Matched
- return unless $captures && ref $captures eq 'HASH';
-
- # Merge captures
- $self->captures($captures);
+ return
+ if !$condition->($r, $self->{_controller}, $self->captures, $value);
}
- # Path
- my $path = $self->{_path};
-
- # Match
- my $captures = $r->pattern->shape_match(\$path);
-
- # No match
- return unless $captures;
-
# Partial
if (my $partial = $r->partial) {
$captures->{$partial} = $path;
@@ -80,7 +74,6 @@ sub match {
}
$self->{_path} = $path;
-
# Merge captures
$captures = {%{$self->captures}, %$captures};
$self->captures($captures);
@@ -173,24 +166,50 @@ sub url_for {
}
}
+ # Captures
+ my $captures = $self->captures;
+
# Named
if ($name) {
- croak qq/Route "$name" used in url_for does not exist/
- unless $endpoint = $self->_find_route($name);
+
+ # Current route
+ if ($name eq 'current') { $name = undef }
+
+ # Find
+ else {
+ $captures = {};
+ croak qq/Route "$name" used in url_for does not exist/
+ unless $endpoint = $self->_find_route($name);
+ }
}
# Merge values
- $values = {%{$self->captures}, %$values};
+ $values = {%$captures, format => undef, %$values};
+ # URL
my $url = Mojo::URL->new;
# No endpoint
return $url unless $endpoint;
+ # Base
+ $url->base($self->{_controller}->req->url->base->clone);
+ my $base = $url->base;
+ $url->base->userinfo(undef);
+
# Render
my $path = $endpoint->render($url->path->to_string, $values);
$url->path->parse($path);
+ # Fix scheme
+ if ($endpoint->is_websocket) {
+ $base->scheme(($base->scheme || '') eq 'https' ? 'wss' : 'ws');
+ }
+
+ # Fix paths
+ unshift @{$url->path->parts}, @{$base->path->parts};
+ $base->path->parts([]);
+
return $url;
}
@@ -278,7 +297,6 @@ implements the following ones.
=head2 C<new>
- my $m = MojoX::Routes::Match->new;
my $m = MojoX::Routes::Match->new(MojoX:Controller->new);
Construct a new match object.
@@ -14,6 +14,8 @@ __PACKAGE__->attr([qw/children conditions/] => sub { [] });
__PACKAGE__->attr(dictionary => sub { {} });
__PACKAGE__->attr(pattern => sub { MojoX::Routes::Pattern->new });
+# Yet thanks to my trusty safety sphere,
+# I sublibed with only tribial brain dablage.
sub new {
my $self = shift->SUPER::new();
@@ -32,7 +34,7 @@ sub new {
my $m = lc $c->req->method;
$m = 'get' if $m eq 'head';
for my $method (@$methods) {
- return $captures if $method eq $m;
+ return 1 if $method eq $m;
}
# Nothing
@@ -46,7 +48,7 @@ sub new {
my ($r, $c, $captures) = @_;
# WebSocket
- return $captures if $c->tx->is_websocket;
+ return 1 if $c->tx->is_websocket;
# Not a WebSocket
return;
@@ -88,6 +90,15 @@ sub is_endpoint {
return 1;
}
+sub is_websocket {
+ my $self = shift;
+ return 1 if $self->{_websocket};
+ if (my $parent = $self->parent) { return $parent->is_websocket }
+ return;
+}
+
+# Dr. Zoidberg, can you note the time and declare the patient legally dead?
+# Can I! That’s my specialty!
sub name {
my ($self, $name) = @_;
@@ -115,7 +126,7 @@ sub over {
# Conditions
my $conditions = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
- $self->conditions($conditions);
+ push @{$self->conditions}, @$conditions;
return $self;
}
@@ -254,6 +265,7 @@ sub websocket {
# Condition
push @{$self->conditions}, websocket => 1;
+ $self->{_websocket} = 1;
return $self;
}
@@ -407,18 +419,25 @@ Add a new bridge to this route as a nested child.
Returns true if this route qualifies as an endpoint.
+=head2 C<is_websocket>
+
+ my $is_websocket = $r->is_websocket;
+
+Returns true if this route leads to a WebSocket.
+
=head2 C<name>
my $name = $r->name;
$r = $r->name('foo');
$r = $r->name('*');
-The name of this route.
+The name of this route, the special value C<*> will generate a name based on
+the route pattern.
+Note that the name C<current> is reserved for refering to the current route.
=head2 C<over>
$r = $r->over(foo => qr/\w+/);
- $r = $r->over({foo => qr/\w+/});
Apply condition parameters to this route.
@@ -7,8 +7,9 @@ use base 'MojoX::Controller';
use Mojo::ByteStream;
use Mojo::Cookie::Response;
+use Mojo::Transaction::HTTP;
-__PACKAGE__->attr([qw/app tx/]);
+__PACKAGE__->attr(tx => sub { Mojo::Transaction::HTTP->new });
# For the last time, I don't like lilacs!
# Your first wife was the one who liked lilacs!
@@ -48,6 +49,7 @@ sub cookie {
return map { $_->value } @cookies;
}
+# You two make me ashamed to call myself an idiot.
sub flash {
my $self = shift;
@@ -172,20 +174,15 @@ L<MojoX::Session::Cookie::Controller> is a controller base class.
=head1 ATTRIBUTES
-L<MojoX::Session::Cookie::Controller> implements the following attributes.
-
-=head2 C<app>
-
- my $app = $c->app;
- $c = $c->app(MojoSubclass->new);
-
-A reference back to the application that dispatched to this controller.
+L<MojoX::Session::Cookie::Controller> inherits all attributes from
+L<MojoX::Controller> and implements the following new ones.
=head2 C<tx>
my $tx = $c->tx;
-The transaction that is currently being processed.
+The transaction that is currently being processed, defaults to a
+L<Mojo::Transaction::HTTP> object.
=head1 METHODS
@@ -208,7 +205,7 @@ Access request cookie values and create new response cookies.
$c = $c->flash({foo => 'bar'});
$c = $c->flash(foo => 'bar');
-Data storage persistent for a single request, stored in the session.
+Data storage persistent for the next request, stored in the session.
$c->flash->{foo} = 'bar';
my $foo = $c->flash->{foo};
@@ -73,7 +73,7 @@ use lib join '/', File::Spec->splitdir(dirname(__FILE__)), '..', 'lib';
# Check if Mojo is installed
eval 'use Mojolicious::Commands';
die <<EOF if $@;
-It looks like you don't have the Mojo Framework installed.
+It looks like you don't have the Mojolicious Framework installed.
Please visit http://mojolicious.org for detailed installation instructions.
EOF
@@ -0,0 +1,89 @@
+package Mojolicious::Command::Generate::Gitignore;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+__PACKAGE__->attr(description => <<'EOF');
+Generate .gitignore.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 generate gitignore
+EOF
+
+# I want to see the edge of the universe.
+# Ooh, that sounds cool.
+# It's funny, you live in the universe, but you never get to do this things
+# until someone comes to visit.
+sub run {
+ my $self = shift;
+ $self->render_to_rel_file('gitignore', '.gitignore');
+ $self->chmod_file('.gitignore', 0644);
+}
+
+1;
+__DATA__
+@@ gitignore
+.*
+!.gitignore
+!.perltidyrc
+*~
+blib
+Makefile*
+!Makefile.PL
+META.yml
+MANIFEST*
+!MANIFEST.SKIP
+pm_to_blib
+__END__
+=head1 NAME
+
+Mojolicious::Command::Generate::Gitignore - Gitignore Generator Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Generate::Gitignore;
+
+ my $gitignore = Mojolicious::Command::Generate::Gitignore->new;
+ $gitignore->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Generate::Gitignore> is a C<.gitignore> generator.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Generate::Gitignore> inherits all attributes from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $gitignore->description;
+ $gitignore = $gitignore->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $gitignore->usage;
+ $gitignore = $gitignore->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Generate::Gitignore> inherits all methods from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<run>
+
+ $gitignore = $gitignore->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -0,0 +1,103 @@
+package Mojolicious::Command::Generate::Makefile;
+
+use strict;
+use warnings;
+
+use base 'Mojo::Command';
+
+__PACKAGE__->attr(description => <<'EOF');
+Generate Makefile.PL.
+EOF
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 generate makefile
+EOF
+
+# If we don't go back there and make that event happen,
+# the entire universe will be destroyed...
+# And as an environmentalist, I'm against that.
+sub run {
+ my $self = shift;
+
+ my $class = $ENV{MOJO_APP} || 'MyApp';
+ my $path = $self->class_to_path($class);
+ my $name = $self->class_to_file($class);
+
+ $self->render_to_rel_file('makefile', 'Makefile.PL', $class, $path,
+ $name);
+ $self->chmod_file('Makefile.PL', 0744);
+}
+
+1;
+__DATA__
+@@ makefile
+% my ($class, $path, $name) = @_;
+#!/usr/bin/env perl
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+# Son, when you participate in sporting events,
+# it's not whether you win or lose, it's how drunk you get.
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => '<%= $class %>',
+ VERSION_FROM => 'lib/<%= $path %>',
+ AUTHOR => 'A Good Programmer <nospam@cpan.org>',
+ EXE_FILES => ['script/<%= $name %>'],
+ PREREQ_PM => { 'Mojo' => '0.9003' },
+ test => {TESTS => 't/*.t t/*/*.t t/*/*/*.t'}
+);
+__END__
+=head1 NAME
+
+Mojolicious::Command::Generate::Makefile - Makefile Generator Command
+
+=head1 SYNOPSIS
+
+ use Mojolicious::Command::Generate::Makefile;
+
+ my $makefile = Mojolicious::Command::Generate::Makefile->new;
+ $makefile->run(@ARGV);
+
+=head1 DESCRIPTION
+
+L<Mojolicious::Command::Generate::Makefile> is a makefile generator.
+
+=head1 ATTRIBUTES
+
+L<Mojolicious::Command::Generate::Makefile> inherits all attributes from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $makefile->description;
+ $makefile = $makefile->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<usage>
+
+ my $usage = $makefile->usage;
+ $makefile = $makefile->usage('Foo!');
+
+Usage information for this command, used for the help screen.
+
+=head1 METHODS
+
+L<Mojolicious::Command::Generate::Makefile> inherits all methods from
+L<Mojo::Command> and implements the following new ones.
+
+=head2 C<run>
+
+ $makefile = $makefile->run(@ARGV);
+
+Run this command.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
+
+=cut
@@ -3,10 +3,25 @@ package Mojolicious::Command::Generate;
use strict;
use warnings;
-use base 'Mojo::Command::Generate';
+use base 'Mojo::Commands';
+__PACKAGE__->attr(description => <<'EOF');
+Generate files and directories from templates.
+EOF
+__PACKAGE__->attr(hint => <<"EOF");
+
+See '$0 generate help GENERATOR' for more information on a specific generator.
+EOF
+__PACKAGE__->attr(message => <<"EOF");
+usage: $0 generate GENERATOR [OPTIONS]
+
+These generators are currently available:
+EOF
__PACKAGE__->attr(namespaces =>
sub { [qw/Mojolicious::Command::Generate Mojo::Command::Generate/] });
+__PACKAGE__->attr(usage => <<"EOF");
+usage: $0 generate GENERATOR [OPTIONS]
+EOF
# Ah, nothing like a warm fire and a SuperSoaker of fine cognac.
@@ -31,14 +46,33 @@ L<Mojolicious::Command::Generate> lists available generators.
=head1 ATTRIBUTES
L<Mojolicious::Command::Generate> inherits all attributes from
-L<Mojo::Command::Generate> and implements the following new ones.
+L<Mojo::Commands> and implements the following new ones.
+
+=head2 C<description>
+
+ my $description = $generator->description;
+ $generator = $generator->description('Foo!');
+
+Short description of this command, used for the command list.
+
+=head2 C<hint>
+
+ my $hint = $generator->hint;
+ $generator = $generator->hint('Foo!');
+
+Short hint shown after listing available generator commands.
+
+=head2 C<message>
+
+ my $message = $generator->message;
+ $generator = $generator->message('Bar!');
+
+Short usage message shown before listing available generator commands.
=head2 C<namespaces>
my $namespaces = $generator->namespaces;
- $generator = $generator->namespaces(
- ['Mojolicious::Command::Generate']
- );
+ $generator = $generator->namespaces(['Mojo::Command::Generate']);
Namespaces to search for available generator commands, defaults to
L<Mojo::Command::Generate> and L<Mojolicious::Command::Generate>.
@@ -46,7 +80,7 @@ L<Mojo::Command::Generate> and L<Mojolicious::Command::Generate>.
=head1 METHODS
L<Mojolicious::Command::Generate> inherits all methods from
-L<Mojo::Command::Generate>.
+L<Mojo::Commands>.
=head1 SEE ALSO
@@ -58,6 +58,7 @@ sub _draw {
}
}
+# I surrender, and volunteer for treason!
sub _walk {
my ($self, $node, $depth, $routes) = @_;
@@ -5,11 +5,30 @@ use warnings;
use base 'Mojo::Commands';
+# One day a man has everything, the next day he blows up a $400 billion
+# space station, and the next day he has nothing. It makes you think.
+use Getopt::Long qw/GetOptions :config pass_through/;
+
+__PACKAGE__->attr(hint => <<"EOF");
+
+These options are available for all commands:
+ --home <path> Path to your applications home directory, defaults to
+ the value of MOJO_HOME or auto detection.
+ --mode <name> Run mode of your application, defaults to the value of
+ MOJO_MODE or development.
+
+See '$0 help COMMAND' for more information on a specific command.
+EOF
__PACKAGE__->attr(
namespaces => sub { [qw/Mojolicious::Command Mojo::Command/] });
-# One day a man has everything, the next day he blows up a $400 billion
-# space station, and the next day he has nothing. It makes you think.
+# Command line options for MOJO_HOME and MOJO_MODE
+BEGIN {
+ GetOptions(
+ 'home=s' => sub { $ENV{MOJO_HOME} = $_[1] },
+ 'mode=s' => sub { $ENV{MOJO_MODE} = $_[1] }
+ ) unless Mojo::Commands->detect;
+}
1;
__END__
@@ -40,28 +59,34 @@ L<Mojo::Commands>.
=item C<generate>
- mojolicious generate
- mojolicious generate help
+ mojo generate
+ mojo generate help
List available generator commands with short descriptions.
- mojolicious generate help <generator>
+ mojo generate help <generator>
List available options for generator command with short descriptions.
=item C<generate app>
- mojolicious generate app <AppName>
+ mojo generate app <AppName>
Generate application directory structure for a fully functional
L<Mojolicious> application.
=item C<generate lite_app>
- mojolicious generate lite_app
+ mojo generate lite_app
Generate a fully functional L<Mojolicious::Lite> application.
+=item C<generate makefile>
+
+ mojo generate makefile
+
+Generate C<Makefile.PL> file for application.
+
=item C<inflate>
myapp.pl inflate
@@ -82,6 +107,13 @@ List application routes.
L<Mojolicious::Commands> inherits all attributes from L<Mojo::Commands> and
implements the following new ones.
+=head2 C<hint>
+
+ my $hint = $commands->hint;
+ $commands = $commands->hint('Foo!');
+
+Short hint shown after listing available commands.
+
=head2 C<namespaces>
my $namespaces = $commands->namespaces;
@@ -11,77 +11,96 @@ use Mojo::URL;
require Carp;
-# Space: It seems to go on and on forever...
-# but then you get to the end and a gorilla starts throwing barrels at you.
-sub client { shift->app->client }
+# DEPRECATED in Comet!
+*finished = \&on_finish;
+*receive_message = \&on_message;
-sub finish {
+our $AUTOLOAD;
+
+# Is all the work done by the children?
+# No, not the whipping.
+sub AUTOLOAD {
my $self = shift;
- # Transaction
- my $tx = $self->tx;
+ # Method
+ my ($package, $method) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
- # Finish WebSocket
- return $tx->finish if $tx->is_websocket;
+ # Helper
+ Carp::croak(qq/Can't locate object method "$method" via "$package"/)
+ unless my $helper = $self->app->renderer->helper->{$method};
- # Render
- $self->app->routes->auto_render($self);
+ # Run
+ return $self->$helper(@_);
+}
- # Finish
- $self->app->finish($self);
+sub DESTROY { }
- # Resume
- $self->resume if $tx->is_paused;
-}
+sub client { shift->app->client }
-sub finished {
- my ($self, $cb) = @_;
+# Something's wrong, she's not responding to my poking stick.
+sub finish {
+ my $self = shift;
- # Transaction finished
- $self->tx->finished(sub { shift and $self->$cb(@_) });
+ # Transaction
+ my $tx = $self->tx;
+
+ # WebSocket check
+ Carp::croak('No WebSocket connection to finish') unless $tx->is_websocket;
+
+ # Finish WebSocket
+ $tx->finish;
}
+# DEPRECATED in Comet!
sub helper {
my $self = shift;
# Name
return unless my $name = shift;
- # Helper
- Carp::croak(qq/Helper "$name" not found/)
- unless my $helper = $self->app->renderer->helper->{$name};
-
# Run
- return $self->$helper(@_);
+ return $self->$name(@_);
}
-sub pause { shift->tx->pause }
+# My parents may be evil, but at least they're stupid.
+sub on_finish {
+ my ($self, $cb) = @_;
+
+ # Transaction finished
+ $self->tx->on_finish(sub { shift and $self->$cb(@_) });
+}
-sub receive_message {
+# Stop being such a spineless jellyfish!
+# You know full well I'm more closely related to the sea cucumber.
+# Not where it counts.
+sub on_message {
my $self = shift;
- # Deactivate auto rendering
- $self->stash->{'mojo.rendered'} = 1;
+ # Transaction
+ my $tx = $self->tx;
# WebSocket check
Carp::croak('No WebSocket connection to receive messages from')
- unless $self->tx->is_websocket;
+ unless $tx->is_websocket;
# Callback
my $cb = shift;
# Receive
- $self->tx->receive_message(sub { shift and $self->$cb(@_) });
+ $tx->on_message(sub { shift and $self->$cb(@_) });
+
+ # Rendered
+ $self->rendered;
return $self;
}
+# Is there an app for kissing my shiny metal ass?
+# Several!
+# Oooh!
sub redirect_to {
my $self = shift;
- # Rendered
- $self->stash->{'mojo.rendered'} = 1;
-
# Response
my $res = $self->res;
@@ -93,6 +112,9 @@ sub redirect_to {
$headers->location($self->url_for(@_)->to_abs);
$headers->content_length(0);
+ # Rendered
+ $self->rendered;
+
return $self;
}
@@ -104,7 +126,7 @@ sub render {
# Template as single argument
my $stash = $self->stash;
my $template;
- $template = shift if (@_ % 2 && !ref $_[0]) || (!@_ % 2 && ref $_[1]);
+ $template = shift if @_ % 2 && !ref $_[0];
# Arguments
my $args = ref $_[0] ? $_[0] : {@_};
@@ -114,18 +136,18 @@ sub render {
unless ($stash->{template} || $args->{template}) {
# Default template
- my $controller = $stash->{controller};
- my $action = $stash->{action};
+ my $controller = $args->{controller} || $stash->{controller};
+ my $action = $args->{action} || $stash->{action};
# Normal default template
if ($controller && $action) {
- $self->stash(
- template => join('/', split(/-/, $controller), $action));
+ $self->stash->{template} =
+ join('/', split(/-/, $controller), $action);
}
# Try the route name if we don't have controller and action
elsif ($self->match && (my $name = $self->match->endpoint->name)) {
- $self->stash(template => $name);
+ $self->stash->{template} = $name;
}
}
@@ -152,6 +174,9 @@ sub render {
my $headers = $res->headers;
$headers->content_type($type) unless $headers->content_type;
+ # Rendered
+ $self->rendered;
+
# Success
return 1;
}
@@ -169,6 +194,8 @@ sub render_data {
return $self->render($args);
}
+# The path to robot hell is paved with human flesh.
+# Neat.
sub render_exception {
my ($self, $e) = @_;
@@ -182,6 +209,7 @@ sub render_exception {
my $options = {
template => 'exception',
format => 'html',
+ handler => undef,
status => 500,
exception => $e,
'mojo.exception' => 1
@@ -189,8 +217,8 @@ sub render_exception {
$self->app->static->serve_500($self)
if $self->stash->{'mojo.exception'} || !$self->render($options);
- # Resume for exceptions
- $self->resume if $self->tx->is_paused;
+ # Rendered
+ $self->rendered;
}
sub render_inner {
@@ -212,6 +240,8 @@ sub render_inner {
return Mojo::ByteStream->new("$content");
}
+# If you hate intolerance and being punched in the face by me,
+# please support Proposition Infinity.
sub render_json {
my $self = shift;
my $json = shift;
@@ -229,7 +259,8 @@ sub render_not_found {
my ($self, $resource) = @_;
# Debug
- $self->app->log->debug(qq/Resource "$resource" not found./) if $resource;
+ $self->app->log->debug(qq/Resource "$resource" not found./)
+ if $resource;
# Render not found template
my $options = {
@@ -240,8 +271,13 @@ sub render_not_found {
$options->{status} = 404 unless $self->stash->{status};
$self->app->static->serve_404($self)
if $self->stash->{not_found} || !$self->render($options);
+
+ # Rendered
+ $self->rendered;
}
+# You called my thesis a fat sack of barf, and then you stole it?
+# Welcome to academia.
sub render_partial {
my $self = shift;
@@ -262,13 +298,18 @@ sub render_partial {
}
sub render_static {
- my $self = shift;
+ my ($self, $file) = @_;
- # Rendered
- $self->stash->{'mojo.rendered'} = 1;
+ # Application
+ my $app = $self->app;
# Static
- $self->app->static->serve($self, @_);
+ $app->static->serve($self, $file)
+ and $app->log->debug(
+ qq/Static file "$file" not found, public directory missing?/);
+
+ # Rendered
+ $self->rendered;
}
sub render_text {
@@ -284,30 +325,70 @@ sub render_text {
return $self->render($args);
}
-sub resume { shift->tx->resume }
+# On the count of three, you will awaken feeling refreshed,
+# as if Futurama had never been canceled by idiots,
+# then brought back by bigger idiots. One. Two.
+sub rendered {
+ my $self = shift;
+
+ # Resume
+ $self->tx->resume;
+
+ # Rendered
+ $self->stash->{'mojo.rendered'} = 1;
+
+ # Stash
+ my $stash = $self->stash;
+
+ # Already finished
+ return $self if $stash->{'mojo.finished'};
+
+ # Application
+ my $app = $self->app;
+
+ # Hook
+ $app->plugins->run_hook_reverse(after_dispatch => $self);
+
+ # Session
+ $app->session->store($self);
+
+ # Finished
+ $stash->{'mojo.finished'} = 1;
+
+ return $self;
+}
sub send_message {
my $self = shift;
- # Deactivate auto rendering
- $self->stash->{'mojo.rendered'} = 1;
+ # Transaction
+ my $tx = $self->tx;
# WebSocket check
Carp::croak('No WebSocket connection to send message to')
- unless $self->tx->is_websocket;
+ unless $tx->is_websocket;
# Send
- $self->tx->send_message(@_);
+ $tx->send_message(@_);
+
+ # Rendered
+ $self->rendered;
return $self;
}
+# Behold, a time traveling machine.
+# Time? I can't go back there!
+# Ah, but this machine only goes forward in time.
+# That way you can't accidentally change history or do something disgusting
+# like sleep with your own grandmother.
+# I wouldn't want to do that again.
sub url_for {
my $self = shift;
my $target = shift || '';
# Make sure we have a match for named routes
- $self->match(MojoX::Routes::Match->new->root($self->app->routes))
+ $self->match(MojoX::Routes::Match->new($self)->root($self->app->routes))
unless $self->match;
# Path
@@ -319,20 +400,64 @@ sub url_for {
# URL
elsif ($target =~ /^\w+\:\/\//) { return Mojo::URL->new($target) }
- # Use match or root
- my $url = $self->match->url_for($target, @_);
+ # Route
+ return $self->match->url_for($target, @_);
+}
+
+# I wax my rocket every day!
+sub write {
+ my ($self, $chunk, $cb) = @_;
+
+ # Callback only
+ if (ref $chunk && ref $chunk eq 'CODE') {
+ $cb = $chunk;
+ $chunk = undef;
+ }
+
+ # Write
+ $self->res->write(
+ $chunk,
+ sub {
+
+ # Cleanup
+ shift;
- # Base
- unless ($url->is_abs) {
- $url->base($self->tx->req->url->base->clone);
- $url->base->userinfo(undef);
+ # Callback
+ $self->$cb(@_) if $cb;
+ }
+ );
+
+ # Rendered
+ $self->rendered;
+}
+
+# This calls for a party, baby.
+# I'm ordering 100 kegs, 100 hookers and 100 Elvis impersonators that aren't
+# above a little hooking should the occasion arise.
+sub write_chunk {
+ my ($self, $chunk, $cb) = @_;
+
+ # Callback only
+ if (ref $chunk && ref $chunk eq 'CODE') {
+ $cb = $chunk;
+ $chunk = undef;
}
- # Fix paths
- unshift @{$url->path->parts}, @{$url->base->path->parts};
- $url->base->path->parts([]);
+ # Write
+ $self->res->write_chunk(
+ $chunk,
+ sub {
+
+ # Cleanup
+ shift;
- return $url;
+ # Callback
+ $self->$cb(@_) if $cb;
+ }
+ );
+
+ # Rendered
+ $self->rendered;
}
1;
@@ -377,63 +502,40 @@ A L<Mojo::Client> prepared for the current environment.
$c->client->get('http://mojolicious.org' => sub {
my $client = shift;
$c->render_data($client->res->body);
- })->process;
+ })->start;
-For async processing you can use C<pause> and C<finish>.
+For async processing you can use C<finish>.
- $c->pause;
$c->client->async->get('http://mojolicious.org' => sub {
my $client = shift;
$c->render_data($client->res->body);
$c->finish;
- })->process;
+ })->start;
=head2 C<finish>
$c->finish;
-Similar to C<resume> but will also trigger automatic rendering and the
-C<after_dispatch> plugin hook, which would normally get disabled once a
-request gets paused.
-For WebSockets it will gracefully end the connection.
+Gracefully end WebSocket connection.
-=head2 C<finished>
+=head2 C<on_finish>
- $c->finished(sub {...});
+ $c->on_finish(sub {...});
Callback signaling that the transaction has been finished.
- $c->finished(sub {
+ $c->on_finish(sub {
my $self = shift;
});
-=head2 C<helper>
-
- $c->helper('foo');
- $c->helper(foo => 23);
-
-Directly call a L<Mojolicious> helper, see
-L<Mojolicious::Plugin::DefaultHelpers> for a list of helpers that are always
-available.
-
-=head2 C<pause>
+=head2 C<on_message>
- $c->pause;
-
-Pause transaction associated with this request, used for async web
-applications.
-Note that automatic rendering and some plugins that do state changing
-operations inside the C<after_dispatch> hook won't work if you pause a
-transaction.
-
-=head2 C<receive_message>
-
- $c = $c->receive_message(sub {...});
+ $c = $c->on_message(sub {...});
Receive messages via WebSocket, only works if there is currently a WebSocket
connection in progress.
- $c->receive_message(sub {
+ $c->on_message(sub {
my ($self, $message) = @_;
});
@@ -444,7 +546,7 @@ connection in progress.
$c = $c->redirect_to('/path');
$c = $c->redirect_to('http://127.0.0.1/foo/bar');
-Prepare a redirect response.
+Prepare a C<302> redirect response.
=head2 C<render>
@@ -458,7 +560,6 @@ Prepare a redirect response.
$c->render(handler => 'something');
$c->render('foo/bar');
$c->render('foo/bar', format => 'html');
- $c->render('foo/bar', {format => 'html'});
This is a wrapper around L<MojoX::Renderer> exposing pretty much all
functionality provided by it.
@@ -520,8 +621,10 @@ Same as C<render> but returns the rendered result.
=head2 C<render_static>
$c->render_static('images/logo.png');
+ $c->render_static('../lib/MyApp.pm');
-Render a static asset using L<MojoX::Dispatcher::Static>.
+Render a static file using L<MojoX::Dispatcher::Static> relative to the
+C<public> directory of your application.
=head2 C<render_text>
@@ -531,12 +634,12 @@ Render a static asset using L<MojoX::Dispatcher::Static>.
Render the given content as plain text, note that text will be encoded.
See C<render_data> for an alternative without encoding.
-=head2 C<resume>
+=head2 C<rendered>
- $c->resume;
+ $c->rendered;
-Resume transaction associated with this request, used for async web
-applications.
+Finalize response and run C<after_dispatch> plugin hook.
+Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<send_message>
@@ -553,6 +656,42 @@ connection in progress.
Generate a L<Mojo::URL> for the current or a named route.
+=head2 C<write>
+
+ $c->write;
+ $c->write('Hello!');
+ $c->write(sub {...});
+ $c->write('Hello!', sub {...});
+
+Write dynamic content matching the corresponding C<Content-Length> header
+chunk wise, the optional drain callback will be invoked once all data has
+been written to the kernel send buffer or equivalent.
+
+ $c->res->headers->content_length(6);
+ $c->write('Hel');
+ $c->write('lo!');
+
+Note that this method is EXPERIMENTAL and might change without warning!
+
+=head2 C<write_chunk>
+
+ $c->write_chunk;
+ $c->write_chunk('Hello!');
+ $c->write_chunk(sub {...});
+ $c->write_chunk('Hello!', sub {...});
+
+Write dynamic content chunk wise with the C<chunked> C<Transfer-Encoding>
+which doesn't require a C<Content-Length> header, the optional drain callback
+will be invoked once all data has been written to the kernel send buffer or
+equivalent.
+An empty chunk marks the end of the stream.
+
+ $c->write_chunk('Hel');
+ $c->write_chunk('lo!');
+ $c->write_chunk('');
+
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
@@ -72,6 +72,12 @@ Format to render.
Handler to use for rendering.
+=head2 C<inline>
+
+ $self->render(inline => '<%= 1 + 1%>');
+
+Inline template to render.
+
=head2 C<json>
$self->render(json => {foo => 23});
@@ -155,6 +161,12 @@ operations but will also use more memory, defaults to C<262144>.
MOJO_CHUNK_SIZE=1024
+=head2 C<MOJO_DNS_SERVER>
+
+C<DNS> server to use for non-blocking lookups.
+
+ MOJO_DNS_SERVER=8.8.8.8
+
=head2 C<MOJO_EPOLL>
Force epoll mainloop for IO operations.
@@ -229,7 +241,7 @@ Note that L<Net::Rendezvous::Publish> must be installed for Bonjour support.
Disable IPv6 support, this might result in slightly better performance and
less memory use.
-Note that L<IO::Socket::INET6> must be installed for IPv6 support.
+Note that L<IO::Socket::IP> must be installed for IPv6 support.
MOJO_NO_IPV6=1
@@ -275,6 +287,12 @@ templates, defaults to C<main>.
MOJO_STATIC_CLASS=MyApp
+=head2 C<MOJO_TEMPLATE_CACHE>
+
+Number of compiled templates to cache in memory, defaults to C<100>.
+
+ MOJO_TEMPLATE_CACHE=20
+
=head2 C<MOJO_TEMPLATE_CLASS>
Class the L<Mojolicious> renderer should use to find C<DATA> templates,
@@ -33,6 +33,8 @@ distribution an example application.
Web development should be easy and fun, this is what we optimize for.
+The web is a moving target, to stay relevant we have to stay in motion too.
+
Keep it simple, no magic unless absolutely necessary.
Code should be written with a Perl6 port in mind.
@@ -54,13 +56,19 @@ unique code name based on a unicode character.
New features can be marked as experimental to be excluded from deprecation
policies.
-Only add prereqs if absolutely necessary.
+Only add prereqs if absolutely necessary and make them optional if possible.
Domain specific languages should be avoided in favor of Perl'ish solutions.
No inline POD.
-Documentation belongs to the book, module POD is just an API reference.
+Documentation belongs to the guides, module POD is just an API reference.
+
+The main focus of the included documentation should be on examples, no walls
+of text. (An example for every one or two sentences is a good rule of thumb)
+
+The master source code repository should always be kept in a stable state,
+use feature branches for actual development.
Lines should not be longer than 78 characters and we indent with 4
whitespaces.
@@ -35,81 +35,6 @@ Another huge advantage is that it supports TLS and WebSockets out of the box.
A development certificate for testing purposes is built right in, so it just
works.
-=head2 Builtin Preforking Server
-
-To allow scaling with multiple CPUs (cores) and to lower the performance loss
-from (slow) blocking APIs the built in web server also has a preforking multi
-process mode.
-It doesn't work on Windows due to UNIX optimizations but is fast and scalable
-enough for large applications.
-
- % ./script/myapp daemon_prefork
- Server available at http://127.0.0.1:3000.
-
-By default it will accept one client connection per worker process just like
-Apache, but this value can be increased, allowing huge amounts of concurrent
-client connections.
-(epoll and kqueue will be used automatically if available)
-
- % ./script/myapp daemon_prefork --clients 100
- Server available at http://127.0.0.1:3000.
-
-=head2 Nginx
-
-One of the most popular setups these days is the builtin preforking web
-server behind a Nginx reverse proxy.
-
- upstream myapp {
- server 127.0.0.1:3000;
- }
- server {
- listen 80;
- server_name localhost;
- location / {
- proxy_read_timeout 300;
- proxy_pass http://myapp;
- }
- }
-
-Also possible using UNIX domain sockets.
-
- upstream myapp {
- server unix:/tmp/myapp.sock;
- }
- server {
- listen 80;
- server_name localhost;
- location / {
- proxy_read_timeout 300;
- proxy_pass http://myapp;
- }
- }
-
-The builtin web server of course supports them as well.
-
- % ./script/myapp daemon_prefork --listen file:///tmp/myapp.sock
- Server available at file:///tmp/myapp.sock.
-
-One interesting side effect here is that you can start multiple prefork web
-servers parallel letting them share the same UNIX domain socket and lock
-file.
-This allows something called C<Hot Deployment>, which essentially means zero
-downtime software updates.
-
- % ./script/myapp daemon_prefork --listen file:///tmp/myapp.sock\
- --pid /tmp/myapp1.pid --lock /tmp/myapp.lock --daemonize
- Server available at file:///tmp/myapp.sock.
-
-All you have to do is update your application code, start a second web server
-instance and after that send a C<USR1> signal to the old instance.
-This will bring down the old web server gracefully, so no active connections
-get interrupted and your users won't notice a thing.
-
- % ./script/myapp daemon_prefork --listen file:///tmp/myapp.sock\
- --pid /tmp/myapp2.pid --lock /tmp/myapp.lock --daemonize
-
- % kill -s USR1 `cat /tmp/myapp1.pid`
-
=head2 Apache/CGI
C<CGI> is supported out of the box and your L<Mojolicious> application will
@@ -246,8 +171,8 @@ manually in your application.
sub startup {
my $self = shift;
- # Use plugin hook to set environment variable for every request
- $self->plugins->add_hook(
+ # Use event hook to set environment variable for every request
+ $self->hook(
before_dispatch => sub { $ENV{SYSTEMROOT} = 'c:\\winnt' }
);
}
@@ -10,9 +10,42 @@ L<Mojolicious> together with the right answers.
=head1 QUESTIONS
+=head2 Does L<Mojolicious> run on Windows systems?
+
+Sure it does!
+Right now there are two different ways of running Perl on the Windows
+platform.
+One is C<Strawberry Perl> and the other is C<ActiveState Perl>.
+Both are capable Perl distributions which are stable, mature and ready for
+production.
+But C<Strawberry Perl> is quite a bit better at dealing with the L<CPAN> and
+especially XS based modules due to its remarkable toolchain.
+With it you can even install modules straight from the source as you would do
+on a Unix based machine.
+
+=head2 Is it possible to run the builtin webserver on Windows?
+
+It is!
+The builtin webserver is great way to run your L<Mojolicious> web application
+on any platform.
+See L<Mojolicious::Guides::Cookbook> for more information about running and
+deploying L<Mojolicious> applications.
+
+Note that if you run your application with the C<--reload> option Windows
+will lock your files.
+A simple Windows editor like C<WordPad> will complain that the file has
+already been opened by a different proccess.
+More capable editors can handle this accordingly and force the change.
+
+=head2 Whats the easiest way to install L<Mojolicious> on UNIX?
+
+Quite possibly this oneliner.
+
+ sudo -s 'curl -L cpanmin.us | perl - "Mojolicious"'
+
=head2 I think L<Mojolicious> is awesome, how can i support you guys?
-Blog and tweet about it, get other people hooked! :)
+Share your success story via blog or twitter, get more people hooked! :)
=head2 I think i have found a bug, what should i do now?
@@ -25,12 +58,12 @@ right.
Writing a test is usually the hardest part of fixing a bug, so the better
your test case the faster it can be fixed. ;)
-Now you are ready to contact the developers via GitHub
+Once thats done you can contact the developers via GitHub
(http://github.com/kraih/mojo), mailing list
(L<http://groups.google.com/group/mojolicious>) or IRC
(C<#mojo> on C<irc.perl.org>).
-If you decide to fix the bug yourself make sure to take a look at
-L<Mojolicious::Guides::CodingGuidelines> too.
+If you decide to fix the bug yourself make sure to also take a look at
+L<Mojolicious::Guides::CodingGuidelines>.
=cut
@@ -70,15 +70,15 @@ usually look a bit better.
<% my $i = 10; %>
Text before.
- <% for (1 .. $i) { %>
- Insert this text 10 times!
+ <% for my $j (1 .. $i) { %>
+ <%= $j %>
<% } %>
Text after.
% my $i = 10;
Text before.
- % for (1 .. $i) {
- Insert this text 10 times!
+ % for my $j (1 .. $i) {
+ %= $j
% }
Text after.
@@ -92,7 +92,7 @@ Semicolons get automatically appended to all expressions.
Only L<Mojo::ByteStream> objects are excluded from automatic escaping.
- <%= Mojo::ByteStream->new('<p>test</p>') %>
+ <%= b('<p>test</p>') %>
You can also add an additional equal sign to the end of a tag to have it
automatically remove all surrounding whitespaces, this allows free indenting
@@ -165,6 +165,17 @@ shortcut.
All values passed to the C<render> call are only temporarily assigned to the
stash and get reset again once rendering is finished.
+=head2 Rendering Inline Templates (C<inline>)
+
+Some renderers such as C<ep> allow templates to be passed inline.
+
+ $self->render(inline => 'The result is <%= 1 + 1%>!');
+
+Since auto detection depends on a path you might have to supply a C<handler>
+too.
+
+ $self->render(inline => "<%= shift->param('foo') %>", handler => 'epl');
+
=head2 Rendering Text (C<text>)
Plain text can be rendered with the C<text> stash value, characters get
@@ -221,27 +232,48 @@ These mappings can be easily extended or changed.
1;
+=head2 Stash Data
+
+Data can be passed to templates through the C<stash> in any of the native
+Perl data types.
+
+ $self->stash(author => 'Sebastian');
+ $self->stash(frameworks => [qw/Catalyst Mojolicious/]);
+ $self->stash(examples => {tweetylicious => 'a microblogging app'});
+
+ <%= $author %>
+ <%= $frameworks->[1] %>
+ <%= $examples->{tweetylicious} %>
+
+Since everything is just Perl normal control structures just work.
+
+ <% for my $framework (@$frameworks) { %>
+ <%= $framework %> was written by <%= $author %>.
+ <% } %>
+
+ <% while (my ($app, $description) = each %$examples) { %>
+ <%= $app %> is a <%= $description %>.
+ <% } %>
+
=head2 Helpers
-Helpers are little functions that are stored in the renderer, not all of them
-are strictly template specific, thats why you can also use the C<helper>
-controller method to call them.
+Helpers are little functions you can use in templates and controller code.
<%= dumper [1, 2, 3] %>
- my $serialized = $self->helper(dumper => [1, 2, 3]);
+ my $serialized = $self->dumper([1, 2, 3]);
-The C<dumper> helper will use L<Data::Dumper> to serialize whatever data
-structure you pass it, this can be very useful for debugging.
+The C<dumper> helper for example will use L<Data::Dumper> to serialize
+whatever data structure you pass it, this can be very useful for debugging.
We differentiate between C<default helpers> which are more general purpose
like C<dumper> and C<tag helpers>, which are template specific and mostly
used to generate C<HTML> tags.
<%= script '/script.js' %>
- <%= script {%>
+ <%= script begin %>
var a = 'b';
- <%}%>
+ <% end %>
The plugins L<Mojolicious::Plugin::DefaultHelpers> and
L<Mojolicious::Plugin::TagHelpers> contain all of them.
@@ -318,25 +350,22 @@ Of course you can also pass stash values.
It's never fun to repeat yourself, thats why you can build reusable template
blocks in C<ep> that work very similar normal Perl functions.
- <% my $block = {%>
+ <% my $block = begin %>
<% my $name = shift; %>
Hello <%= $name %>.
- <%}%>
+ <% end %>
<%= $block->('Sebastian') %>
<%= $block->('Sara') %>
-Blocks start with an opening bracket in the first tag and end with a mini tag
-containing only the closing bracket.
-Whitespace characters between bracket and tag are not allowed, to
-differentiate between template blocks and normal Perl code.
+Blocks are always delimited by the C<begin> and C<end> keywords.
- <% my $block = {%>
- <% my $name = shift; %>
+ % my $block = begin
+ % my $name = shift;
Hello <%= $name %>.
- <%}%>
- <% for (1 .. 10) { %>
- <%= $block->('Sebastian') %>
- <% } %>
+ % end
+ % for (1 .. 10) {
+ %= $block->('Sebastian')
+ % }
A naive translation to equivalent Perl code could look like this.
@@ -359,9 +388,9 @@ the template to the layout.
@@ foo/bar.html.ep
% layout 'mylayout';
- <% content header => {%>
+ <% content header => begin %>
<title>MyApp!</title>
- <%}%>
+ <% end %>
Hello World!
@@ layouts/mylayout.html.ep
@@ -381,30 +410,40 @@ extended templates don't get prefixed with C<layout/>.
@@ first.html.ep
%# "<div>First header!First footer!</div>"
<div>
- <%= content header => {%>
+ <%= content header => begin %>
First header!
- <%}%>
- <%= content footer => {%>
+ <% end %>
+ <%= content footer => begin %>
First footer!
- <%}%>
+ <% end %>
</div>
@@ second.html.ep
%# "<div>Second header!First footer!</div>"
% extends 'first';
- <% content header => {%>
+ <% content header => begin %>
Second header!
- <%}%>
+ <% end %>
@@ third.html.ep
%# "<div>Second header!Third footer!</div>"
% extends 'second';
- <% content footer => {%>
+ <% content footer => begin %>
Third footer!
- <%}%>
+ <% end %>
This chain could go on and on to allow a very high level of template reuse.
+=head2 Memorizing Template Blocks
+
+Compiled templates are always cached in memory, but with the C<memorize>
+helper you can go one step further and prevent template blocks from being
+executed more than once.
+
+ <%= memorize begin %>
+ This template was compiled at <%= localtime time %>.
+ <% end %>
+
=head1 ADVANCED
Less commonly used and more powerful features.
@@ -430,13 +469,22 @@ can be easily changed.
All templates from the DATA section are bound to the encoding of the Perl
script, so don't forget to use the L<utf8> pragma if necessary.
+=head2 Base64 Encoded DATA Files
+
+Base64 encoded static files such as images can be easily stored in the
+C<DATA> section of your application, similar to templates.
+
+ @@ favicon.ico (base64)
+ ...base64 encoded image...
+
=head2 Inflating DATA Templates
Templates stored in files get preferred over files from the C<DATA> section,
this allows you to include a default set of templates in your application
that the user can later customize.
-The C<inflate> command will write all templates from the C<DATA> section into
-actual files in the C<templates> directory.
+The C<inflate> command will write all templates and static files from the
+C<DATA> section into actual files in the C<templates> and C<public>
+directories.
% ./myapp.pl inflate
...
@@ -473,10 +521,35 @@ much everything.
use Mojolicious::Lite;
- app->renderer->add_helper(
- echo => sub {
+ app->helper(
+ debug => sub {
my ($self, $string) = @_;
- return "ECHO: $string";
+ $self->app->log->debug($string);
+ }
+ );
+
+ get '/' => sub {
+ my $self = shift;
+ $self->debug('action');
+ } => 'index';
+
+ app->start;
+ __DATA__
+
+ @@ index.html.ep
+ % debug 'template';
+
+Helpers can also accept template blocks as last argument, this for example
+allows very pleasant to use tag helpers and filters.
+
+ use Mojolicious::Lite;
+
+ app->helper(
+ trim_newline => sub {
+ my ($self, $block) = @_;
+ my $result = $block->();
+ $result =~ s/\n//g;
+ return $result;
}
);
@@ -486,7 +559,11 @@ much everything.
__DATA__
@@ index.html.ep
- <%= echo 'lalala' %>
+ <%= trim_newline begin %>
+ Some text.
+ <%= 1 + 1 %>
+ More text.
+ <% end %>
=head2 Adding Your Favorite Template System
@@ -98,7 +98,7 @@ all characters except C</> and C<.>.
/sebastian23/hello -> /:name/hello -> {name => 'sebastian23'}
/sebastian 23/hello -> /:name/hello -> {name => 'sebastian 23'}
-A generic placeholder can be surrounded by backets to separate it from the
+A generic placeholder can be surrounded by brackets to separate it from the
surrounding text.
/hello -> /(:name)hello -> undef
@@ -363,6 +363,12 @@ non-word characters.
# Generate URL "/foo/bar"
$self->url_for('foobar');
+For refering to the current route you can always use the reserved name
+C<current>.
+
+ # Generate URL for current route
+ $self->url_for('current');
+
=head2 HTTP Methods
The C<via> method of the route object allows only specific HTTP methods to
@@ -477,9 +483,9 @@ This is where conditions come into play, they are basically router plugins.
# User supplied regular expression
return unless $pattern && ref $pattern eq 'Regexp';
- # Match "User-Agent" header and return captured values on success
+ # Match "User-Agent" header and return true on success
my $agent = $c->req->headers->user_agent;
- return $captures if $agent && $agent =~ $pattern;
+ return 1 if $agent && $agent =~ $pattern;
# No success
return;
@@ -515,7 +521,7 @@ You can also package your conditions as reusable plugins.
return if abs(14 - (phase(time))[2]) > ($days / 2);
# It's ok, no werewolf
- return $captures;
+ return 1;
}
);
}
@@ -649,7 +655,7 @@ You can restrict access to WebSocket handshakes using the C<websocket> method.
# Action
sub echo {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$self->send_message("echo: $message");
@@ -48,4 +48,9 @@ A must read for developers and contributors!
=back
+=head1 MORE
+
+A lot more documentation and examples by many different authors can be found
+in the Mojolicious wiki at L<http://github.com/kraih/mojo/wiki>.
+
=cut
@@ -5,6 +5,8 @@ use warnings;
use base 'Mojolicious';
+# Since when is the Internet all about robbing people of their privacy?
+# August 6, 1991.
use File::Spec;
use FindBin;
@@ -38,20 +40,15 @@ sub import {
my $conditions = [];
# Route information
- my $condition;
- while (my $arg = shift @args) {
-
- # Condition can be everything
- if ($condition) {
- push @$conditions, $condition => $arg;
- $condition = undef;
- }
+ while (defined(my $arg = shift @args)) {
# First scalar is the pattern
- elsif (!ref $arg && !$pattern) { $pattern = $arg }
+ if (!ref $arg && !$pattern) { $pattern = $arg }
# Scalar
- elsif (!ref $arg && @args) { $condition = $arg }
+ elsif (!ref $arg && @args) {
+ push @$conditions, $arg, shift @args;
+ }
# Last scalar is the route name
elsif (!ref $arg) { $name = $arg }
@@ -147,7 +144,7 @@ Mojolicious::Lite - Micro Web Framework
=head1 DESCRIPTION
-L<Mojolicous::Lite> is a micro web framework built around L<Mojolicious>.
+L<Mojolicious::Lite> is a micro web framework built around L<Mojolicious>.
A minimal Hello World application looks like this, L<strict> and L<warnings>
are automatically enabled and a few functions imported when you use
@@ -164,7 +161,7 @@ application.
There is also a helper command to generate a small example application.
- % mojolicious generate lite_app
+ % mojo generate lite_app
All the normal L<Mojolicious> command options are available from the command
line.
@@ -177,9 +174,6 @@ will just work without commands.
% ./myapp.pl daemon --listen http://*:8080
Server available at http://127.0.0.1:8080.
- % ./myapp.pl daemon_prefork
- Server available at http://127.0.0.1:3000.
-
% ./myapp.pl cgi
...CGI output...
@@ -230,12 +224,8 @@ simply equal to the route without non-word characters.
__DATA__
@@ index.html.ep
- <%= link_to foo => {%>
- Foo
- <%}%>.
- <%= link_to bar => {%>
- Bar
- <%}%>.
+ <%= link_to Foo => 'foo' %>.
+ <%= link_to Bar => 'bar' %>.
@@ foo.html.ep
<a href="<%= url_for 'index' %>">Home</a>.
@@ -267,10 +257,10 @@ Template blocks can be reused like functions in Perl scripts.
__DATA__
@@ block.html.ep
- <% my $link = {%>
+ <% my $link = begin %>
<% my ($url, $name) = @_; %>
- Try <%= link_to $url => {%><%= $name %><%}%>!
- <%}%>
+ Try <%= link_to $url => begin %><%= $name %><% end %>!
+ <% end %>
<!doctype html><html>
<head><title>Sebastians Frameworks!</title></head>
<body>
@@ -292,18 +282,26 @@ other.
@@ first.html.ep
<!doctype html><html>
- <head><%= content header => {%><title>Hi!</title><%}%></head>
- <body><%= content body => {%>First page!<%}%></body>
+ <head>
+ <%= content header => begin %>
+ <title>Hi!</title>
+ <% end %>
+ </head>
+ <body>
+ <%= content body => begin %>
+ First page!
+ <% end %>
+ </body>
</html>
@@ second.html.ep
% extends 'first';
- <% content header => {%>
+ <% content header => begin %>
<title>Howdy!</title>
- <%}%>
- <% content body => {%>
+ <% end %>
+ <% content body => begin %>
Second page!
- <%}%>
+ <% end %>
Route placeholders allow capturing parts of a request path until a C</> or
C<.> separator occurs, results will be stored by name in the C<stash> and
@@ -442,19 +440,19 @@ multiple features at once.
@@ index.html.ep
% layout 'funky';
Who is groovy?
- <%= form_for test => (method => 'post') => {%>
- <%= input 'groovy', type => 'text' %>
- <input type="submit" value="Woosh!" />
- <%}%>
+ <%= form_for test => (method => 'post') => begin %>
+ <%= text_field 'groovy' %>
+ <%= submit_button 'Woosh!' %>
+ <% end %>
@@ welcome.html.ep
<%= $groovy %> is groovy!
<%= include 'menu' %>
@@ menu.html.ep
- <%= link_to index => {%>
+ <%= link_to index => begin %>
Try again
- <%}%>
+ <% end %>
@@ layouts/funky.html.ep
<!doctype html><html>
@@ -495,6 +493,21 @@ true value.
@@ index.html.ep
Hi Bender!
+Prefixing multiple routes is another good use for C<under>.
+
+ use Mojolicious::Lite;
+
+ # /foo
+ under '/foo';
+
+ # GET /foo/bar
+ get '/bar' => sub { shift->render(text => 'bar!') };
+
+ # GET /foo/baz
+ get '/baz' => sub { shift->render(text => 'baz!') };
+
+ app->start;
+
Conditions such as C<agent> allow even more powerful route constructs.
# /foo
@@ -531,8 +544,9 @@ Formats can be automatically detected by looking at file extensions.
Signed cookie based sessions just work out of the box as soon as you start
using them.
-The C<flash> can be used to store values that will only be available for one
-request, this is very useful in combination with C<redirect_to>.
+The C<flash> can be used to store values that will only be available for the
+next request (unlike C<stash>, which is only available for the current
+request), this is very useful in combination with C<redirect_to>.
use Mojolicious::Lite;
@@ -569,16 +583,16 @@ request, this is very useful in combination with C<redirect_to>.
@@ login.html.ep
% layout 'default';
- <%= form_for login => {%>
+ <%= form_for login => begin %>
<% if (param 'name') { %>
<b>Wrong name or password, please try again.</b><br />
<% } %>
Name:<br />
- <%= input name => (type => 'text') %><br />
+ <%= text_field 'name' %><br />
Password:<br />
- <%= input pass => (type => 'text') %><br />
- <input type="submit" value="Login" />
- <%}%>
+ <%= password_field 'pass' %><br />
+ <%= submit_button 'Login' %>
+ <% end %>
@@ index.html.ep
% layout 'default';
@@ -586,9 +600,9 @@ request, this is very useful in combination with C<redirect_to>.
<b><%= $message %></b><br />
<% } %>
Welcome <%= session 'name' %>!<br />
- <%= link_to logout => {%>
+ <%= link_to logout => begin %>
Logout
- <%}%>
+ <% end %>
Note that you should use a custom C<secret> to make signed cookies really secure.
@@ -608,7 +622,7 @@ WebSocket applications have never been this easy before.
websocket '/echo' => sub {
my $self = shift;
- $self->receive_message(sub {
+ $self->on_message(sub {
my ($self, $message) = @_;
$self->send_message("echo: $message");
});
@@ -638,7 +652,9 @@ Static files will be automatically served from the C<DATA> section
% mv something.js public/something.js
Testing your application is as easy as creating a C<t> directory and filling
-it with normal Perl unit tests like C<t/funky.t>.
+it with normal Perl unit tests.
+Some plugins depend on the actual script name, so a test file for the
+application C<myapp.pl> should be named C<t/myapp.t>.
use Test::More tests => 3;
use Test::Mojo;
@@ -654,15 +670,15 @@ Run all unit tests with the C<test> command.
% ./myapp.pl test
-To make your tests less noisy you can also change the application log level
-directly in your test files.
+To make your tests more noisy and show you all log messages you can also
+change the application log level directly in your test files.
- $t->app->log->level('error');
+ $t->app->log->level('debug');
To disable debug messages later in a production setup you can change the
L<Mojolicious> mode, default will be C<development>.
- % MOJO_MODE=production ./myapp.pl
+ % ./myapp.pl --mode production
Log messages will be automatically written to a C<log/$mode.log> file if a
C<log> directory exists.
@@ -701,10 +717,68 @@ L<Mojolicious::Lite> and L<Mojolicious> applications.
Both share about 99% of the same code, so almost everything you learned in
this tutorial applies there too. :)
- % mojolicious generate app
+ % mojo generate app
Have fun!
+=head1 FUNCTIONS
+
+L<Mojolicious::Lite> implements the following functions.
+
+=head2 C<any>
+
+ my $route = any '/:foo' => sub {...};
+ my $route = any [qw/get post/] => '/:foo' => sub {...};
+
+Generate route matching any of the listed HTTP request methods or all.
+See also the tutorial above for more argument variations.
+
+=head2 C<app>
+
+ my $app = app;
+
+The L<Mojolicious::Lite> application.
+
+=head2 C<get>
+
+ my $route = get '/:foo' => sub {...};
+
+Generate route matching only C<GET> requests.
+See also the tutorial above for more argument variations.
+
+=head2 C<plugin>
+
+ plugin 'something';
+ plugin 'something', foo => 23;
+ plugin 'something', {foo => 23};
+ plugin 'Foo::Bar';
+ plugin 'Foo::Bar', foo => 23;
+ plugin 'Foo::Bar', {foo => 23};
+
+Load a plugin.
+
+=head2 C<post>
+
+ my $route = post '/:foo' => sub {...};
+
+Generate route matching only C<POST> requests.
+See also the tutorial above for more argument variations.
+
+=head2 C<under>
+
+ my $route = under sub {...};
+ my $route = under '/:foo';
+
+Generate bridge to which all following routes are automatically appended.
+See also the tutorial above for more argument variations.
+
+=head2 C<websocket>
+
+ my $route = websocket '/:foo' => sub {...};
+
+Generate route matching only C<WebSocket> handshakes.
+See also the tutorial above for more argument variations.
+
=head1 ATTRIBUTES
L<Mojolicious::Lite> inherits all attributes from L<Mojolicious>.
@@ -20,7 +20,7 @@ sub register {
# Match
my $agent = $c->req->headers->user_agent;
- return $captures if $agent && $agent =~ $pattern;
+ return 1 if $agent && $agent =~ $pattern;
# Nothing
return;
@@ -15,21 +15,21 @@ sub register {
$conf ||= {};
# Set charset
- $app->plugins->add_hook(
+ $app->hook(
before_dispatch => sub {
- my ($self, $c) = @_;
+ my $self = shift;
# Got a charset
if (my $charset = $conf->{charset}) {
# This has to be done before params are cloned
- $c->tx->req->default_charset($charset);
+ $self->tx->req->default_charset($charset);
# Add charset to text/html content type
- my $type = $c->app->types->type('html');
+ my $type = $self->app->types->type('html');
unless ($type =~ /charset=/) {
$type .= ";charset=$charset";
- $c->app->types->type(html => $type);
+ $self->app->types->type(html => $type);
}
}
@@ -39,7 +39,7 @@ sub register {
defined $conf->{encoding}
? $conf->{encoding}
: $conf->{charset};
- $c->app->renderer->encoding($encoding) if $encoding;
+ $self->app->renderer->encoding($encoding) if $encoding;
}
);
}
@@ -13,13 +13,13 @@ sub register {
my ($self, $app) = @_;
# Add "app" helper
- $app->renderer->add_helper(app => sub { shift->app });
+ $app->helper(app => sub { shift->app });
# Add "content" helper
- $app->renderer->add_helper(content => sub { shift->render_inner(@_) });
+ $app->helper(content => sub { shift->render_inner(@_) });
# Add "dumper" helper
- $app->renderer->add_helper(
+ $app->helper(
dumper => sub {
shift;
Data::Dumper->new([@_])->Maxdepth(2)->Indent(1)->Terse(1)->Dump;
@@ -27,30 +27,85 @@ sub register {
);
# Add "extends" helper
- $app->renderer->add_helper(extends => sub { shift->stash(extends => @_) }
+ $app->helper(
+ extends => sub {
+ my $self = shift;
+ my $stash = $self->stash;
+ $stash->{extends} = shift if @_;
+ $self->stash(@_) if @_;
+ return $stash->{extends};
+ }
);
# Add "flash" helper
- $app->renderer->add_helper(flash => sub { shift->flash(@_) });
+ $app->helper(flash => sub { shift->flash(@_) });
# Add "include" helper
- $app->renderer->add_helper(include => sub { shift->render_partial(@_) });
+ $app->helper(include => sub { shift->render_partial(@_) });
# Add "layout" helper
- $app->renderer->add_helper(layout => sub { shift->stash(layout => @_) });
+ $app->helper(
+ layout => sub {
+ my $self = shift;
+ my $stash = $self->stash;
+ $stash->{layout} = shift if @_;
+ $self->stash(@_) if @_;
+ return $stash->{layout};
+ }
+ );
+
+ # Add "memorize" helper
+ my $memorize = {};
+ $app->helper(
+ memorize => sub {
+ shift;
+
+ # Callback
+ my $cb = pop;
+ return '' unless ref $cb && ref $cb eq 'CODE';
+
+ # Name
+ my $name = shift;
+
+ # Arguments
+ my $args;
+ if (ref $name && ref $name eq 'HASH') {
+ $args = $name;
+ $name = undef;
+ }
+ else { $args = shift || {} }
+
+ # Default name
+ $name ||= join '', map { $_ || '' } caller(1);
+
+ # Expire
+ my $expires = $args->{expires} || 0;
+ delete $memorize->{$name}
+ if exists $memorize->{$name}
+ && $expires > 0
+ && $memorize->{$name}->{expires} < time;
+
+ # Memorized
+ return $memorize->{$name}->{content} if exists $memorize->{$name};
+
+ # Memorize
+ $memorize->{$name}->{expires} = $expires;
+ $memorize->{$name}->{content} = $cb->();
+ }
+ );
# Add "param" helper
- $app->renderer->add_helper(param =>
+ $app->helper(param =>
sub { wantarray ? (shift->param(@_)) : scalar shift->param(@_); });
# Add "session" helper
- $app->renderer->add_helper(session => sub { shift->session(@_) });
+ $app->helper(session => sub { shift->session(@_) });
# Add "stash" helper
- $app->renderer->add_helper(stash => sub { shift->stash(@_) });
+ $app->helper(stash => sub { shift->stash(@_) });
# Add "url_for" helper
- $app->renderer->add_helper(url_for => sub { shift->url_for(@_) });
+ $app->helper(url_for => sub { shift->url_for(@_) });
}
1;
@@ -79,42 +134,84 @@ L<Mojolicious>.
=item content
+ <%= content %>
+
Insert content into a layout template.
=item dumper
+ <%= dumper $foo %>
+
Dump a Perl data structure using L<Data::Dumper>.
=item extends
+ <% extends 'foo'; %>
+
Extend a template.
=item flash
+ <%= flash 'foo' %>
+
Access flash values.
=item include
+ <%= include 'menubar' %>
+ <%= include 'menubar', format => 'txt' %>
+
Include a partial template.
=item layout
+ <% layout 'green'; %>
+
Render this template with a layout.
+=item memorize
+
+ <%= memorize begin %>
+ <%= time %>
+ <% end %>
+ <%= memorize {expires => time + 1} => begin %>
+ <%= time %>
+ <% end %>
+ <%= memorize foo => begin %>
+ <%= time %>
+ <% end %>
+ <%= memorize foo => {expires => time + 1} => begin %>
+ <%= time %>
+ <% end %>
+
+Memorize block result in memory and prevent future execution.
+Note that this helper is EXPERIMENTAL and might change without warning!
+
=item param
+ <%= param 'foo' %>
+
Access request parameters and routes captures.
=item session
+ <%= session 'foo' %>
+
Access session values.
=item stash
+ <%= stash 'foo' %>
+ <% stash foo => 'bar'; %>
+
Access stash values.
=item url_for
+ <%= url_for %>
+ <%= url_for 'index' %>
+ <%= url_for 'index', foo => 'bar' %>
+
Generate URLs.
=back
@@ -28,7 +28,8 @@ sub register {
my ($r, $c, $output, $options) = @_;
# Generate name
- return unless my $path = $r->template_path($options);
+ my $path = $r->template_path($options) || $options->{inline};
+ return unless defined $path;
my $list = join ', ', sort keys %{$c->stash};
my $cache = $options->{cache} =
b("$path($list)")->md5_sum->to_string;
@@ -41,13 +42,12 @@ sub register {
local $ENV{MOJO_RELOAD} = 0 if $ENV{MOJO_RELOAD};
# Cache
- $r->{_epl_cache} ||= {};
- unless ($r->{_epl_cache}->{$cache}) {
+ my $ec = $r->{_epl_cache} ||= {};
+ unless ($ec->{$cache}) {
# Initialize
$template->{namespace} ||= "Mojo::Template::$cache";
- my $mt = $r->{_epl_cache}->{$cache} =
- Mojo::Template->new($template);
+ my $mt = $ec->{$cache} = Mojo::Template->new($template);
# Self
my $prepend = 'my $self = shift;';
@@ -5,6 +5,7 @@ use warnings;
use base 'Mojolicious::Plugin';
+use Mojo::ByteStream 'b';
use Mojo::Template;
# Clever things make people feel stupid and unexpected things make them feel
@@ -17,46 +18,64 @@ sub register {
epl => sub {
my ($r, $c, $output, $options) = @_;
+ # Inline
+ my $inline = $options->{inline};
+
# Template
- return unless my $t = $r->template_name($options);
- return unless my $path = $r->template_path($options);
+ my $path = $r->template_path($options);
+ $path = b($inline)->md5_sum->to_string if defined $inline;
+ return unless defined $path;
my $cache = delete $options->{cache} || $path;
# Reload
delete $r->{_epl_cache} if $ENV{MOJO_RELOAD};
# Check cache
- $r->{_epl_cache} ||= {};
- my $mt = $r->{_epl_cache}->{$cache};
+ my $ec = $r->{_epl_cache} ||= {};
+ my $stack = $r->{_epl_stack} ||= [];
+ my $mt = $ec->{$cache};
+
+ # Initialize
+ $mt ||= Mojo::Template->new;
- # Interpret again
+ # Cached
if ($mt && $mt->compiled) { $$output = $mt->interpret($c) }
- # No cache
+ # Not cached
else {
- # Initialize
- $mt ||= Mojo::Template->new;
+ # Inline
+ if (defined $inline) { $$output = $mt->render($inline, $c) }
- # Encoding
- $mt->encoding($r->encoding) if $r->encoding;
+ # File
+ else {
- # Try template
- if (-r $path) { $$output = $mt->render_file($path, $c) }
+ # Encoding
+ $mt->encoding($r->encoding) if $r->encoding;
- # Try DATA section
- elsif (my $d = $r->get_inline_template($options, $t)) {
- $$output = $mt->render($d, $c);
- }
+ # Name
+ return unless my $t = $r->template_name($options);
- # No template
- else {
- $c->render_not_found($t);
- return;
+ # Try template
+ if (-r $path) { $$output = $mt->render_file($path, $c) }
+
+ # Try DATA section
+ elsif (my $d = $r->get_inline_template($options, $t)) {
+ $$output = $mt->render($d, $c);
+ }
+
+ # No template
+ else {
+ $c->render_not_found($t);
+ return;
+ }
}
# Cache
- $r->{_epl_cache}->{$cache} = $mt;
+ delete $ec->{shift @$stack}
+ while @$stack > ($ENV{MOJO_TEMPLATE_CACHE} || 100);
+ push @$stack, $cache;
+ $ec->{$cache} = $mt;
}
# Exception
@@ -35,7 +35,7 @@ sub register {
}
# Success
- return $captures if $passed;
+ return 1 if $passed;
# Robot 1-X, save my friends! And Zoidberg!
return;
@@ -29,34 +29,32 @@ sub register {
die qq/Couldn't initialize I18N class "$namespace": $@/ if $@;
# Start timer
- $app->plugins->add_hook(
+ $app->hook(
before_dispatch => sub {
- my ($self, $c) = @_;
+ my $self = shift;
# Header detection
my @languages = I18N::LangTags::implicate_supers(
I18N::LangTags::Detect->http_accept_langs(
- scalar $c->req->headers->accept_language
+ $self->req->headers->accept_language
)
);
# Handler
- $c->stash->{i18n} =
+ $self->stash->{i18n} =
Mojolicious::Plugin::I18n::_Handler->new(
_namespace => $namespace);
# Languages
- $c->stash->{i18n}->languages(@languages, $default);
+ $self->stash->{i18n}->languages(@languages, $default);
}
);
# Add "languages" helper
- $app->renderer->add_helper(
- languages => sub { shift->stash->{i18n}->languages(@_) });
+ $app->helper(languages => sub { shift->stash->{i18n}->languages(@_) });
# Add "l" helper
- $app->renderer->add_helper(l => sub { shift->stash->{i18n}->localize(@_) }
- );
+ $app->helper(l => sub { shift->stash->{i18n}->localize(@_) });
}
# Container
@@ -21,6 +21,7 @@ sub register {
# File
my $file = $conf->{file};
+ my $mode_file;
unless ($file) {
# Basename
@@ -29,6 +30,9 @@ sub register {
# Remove .pl, .p6 and .t extentions
$file =~ s/(?:\.p(?:l|6))|\.t$//i;
+ # Mode specific config file
+ $mode_file = join '.', $file, $app->mode, ($conf->{ext} || 'json');
+
# Default extension
$file .= '.' . ($conf->{ext} || 'json');
}
@@ -36,6 +40,8 @@ sub register {
# Absolute path
$file = $app->home->rel_file($file)
unless File::Spec->file_name_is_absolute($file);
+ $mode_file = $app->home->rel_file($mode_file)
+ if defined $mode_file && !File::Spec->file_name_is_absolute($mode_file);
# Read config file
my $config = {};
@@ -54,6 +60,12 @@ sub register {
qq/Config file "$file" missing, using default config./);
}
+ # Merge with mode specific config file
+ if (defined $mode_file && -e $mode_file) {
+ my $mode_config = $self->_read_config($mode_file, $template, $app);
+ $config = {%$config, %$mode_config};
+ }
+
# Stash key
my $stash_key = $conf->{stash_key} || 'config';
@@ -156,6 +168,8 @@ L<Mojolicous::Plugin::JsonConfig> is a JSON configuration plugin that
preprocesses it's input with L<Mojo::Template>.
The application object can be accessed via C<$app> or the C<app> helper.
+You can extend the normal config file C<myapp.json> with C<mode> specific
+ones like C<myapp.$mode.json>.
=head2 Options
@@ -202,7 +216,7 @@ L<Mojolicious::Plugin> and implements the following new ones.
$plugin->register;
-Register plugin hooks in L<Mojolicious> application.
+Register plugin in L<Mojolicious> application.
=head1 SEE ALSO
@@ -5,7 +5,7 @@ use warnings;
use base 'Mojolicious::Plugin';
-use Mojo::ByteStream;
+use Mojo::ByteStream 'b';
# Core module since Perl 5.9.3, so it might not always be present
BEGIN {
@@ -36,8 +36,7 @@ sub register {
);
# Add "pod_to_html" helper
- $app->renderer->add_helper(pod_to_html =>
- sub { shift; Mojo::ByteStream->new($self->_pod_to_html(@_)) });
+ $app->helper(pod_to_html => sub { shift; b($self->_pod_to_html(@_)) });
}
sub _pod_to_html {
@@ -63,8 +62,8 @@ sub _pod_to_html {
return $@ if $@;
# Filter
- $output =~ s/<a name='___top' class='dummyTopAnchor'\s*><\/a>\n//g;
- $output =~ s/<a class='u'.*name=".*"\s*>(.*)<\/a>/$1/sg;
+ $output =~ s/<a name='___top' class='dummyTopAnchor'\s*?><\/a>\n//g;
+ $output =~ s/<a class='u'.*?name=".*?"\s*>(.*?)<\/a>/$1/sg;
return $output;
}
@@ -119,7 +118,7 @@ L<Mojolicous::Plugin::PodRenderer> is a renderer for true Perl hackers, rawr!
=item pod_to_html
<%= pod_to_html '=head2 lalala' %>
- <%= pod_to_html {%>=head2 lalala<%}%>
+ <%= pod_to_html begin %>=head2 lalala<% end %>
Render POD to HTML.
@@ -18,10 +18,9 @@ sub register {
my $name = $args->{name} || 'Mojolicious (Perl)';
# Add header
- $app->plugins->add_hook(
+ $app->hook(
after_build_tx => sub {
- my ($self, $tx) = @_;
- $tx->res->headers->header('X-Powered-By' => $name);
+ shift->res->headers->header('X-Powered-By' => $name);
}
);
}
@@ -13,26 +13,25 @@ sub register {
my ($self, $app) = @_;
# Start timer
- $app->plugins->add_hook(
+ $app->hook(
before_dispatch => sub {
- my ($self, $c) = @_;
- $c->stash('mojo.started' => [Time::HiRes::gettimeofday()]);
+ shift->stash('mojo.started' => [Time::HiRes::gettimeofday()]);
}
);
# End timer
- $app->plugins->add_hook(
+ $app->hook(
after_dispatch => sub {
- my ($self, $c) = @_;
- return unless my $started = $c->stash('mojo.started');
+ my $self = shift;
+ return unless my $started = $self->stash('mojo.started');
my $elapsed = sprintf '%f',
Time::HiRes::tv_interval($started,
[Time::HiRes::gettimeofday()]);
my $rps = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
- my $res = $c->res;
+ my $res = $self->res;
my $code = $res->code || 200;
my $message = $res->message || $res->default_message($code);
- $c->app->log->debug("$code $message (${elapsed}s, $rps/s).");
+ $self->app->log->debug("$code $message (${elapsed}s, $rps/s).");
}
);
}
@@ -5,103 +5,279 @@ use warnings;
use base 'Mojolicious::Plugin';
-use Mojo::ByteStream;
+use Mojo::ByteStream 'b';
# Is today's hectic lifestyle making you tense and impatient?
# Shut up and get to the point!
sub register {
my ($self, $app) = @_;
- # Add "form_for" helper
- $app->renderer->add_helper(
- form_for => sub {
+ # Add "checkbox" helper
+ $app->helper(
+ check_box => sub {
+ $self->_input(
+ shift, shift,
+ value => shift,
+ @_, type => 'checkbox'
+ );
+ }
+ );
+
+ # Add "file_field" helper
+ $app->helper(
+ file_field => sub {
my $c = shift;
my $name = shift;
+ $self->_tag('input', name => $name, type => 'file', @_);
+ }
+ );
+
+ # Add "form_for" helper
+ $app->helper(
+ form_for => sub {
+ my $c = shift;
+ my @url = (shift);
# Captures
- my $captures = ref $_[0] eq 'HASH' ? shift : {};
+ push @url, shift if ref $_[0] eq 'HASH';
- $self->_tag('form', action => $c->url_for($name, $captures), @_);
+ $self->_tag('form', action => $c->url_for(@url), @_);
}
);
- # Add "img" helper
- $app->renderer->add_helper(
- img => sub { shift; $self->_tag('img', src => shift, @_) });
-
- # Add "input" helper
- $app->renderer->add_helper(
- input => sub {
- my $c = shift;
- my $name = shift;
-
- # Value
- if (defined(my $p = $c->param($name))) {
+ # Add "hidden_field" helper
+ $app->helper(
+ hidden_field => sub {
+ shift;
+ $self->_tag(
+ 'input',
+ name => shift,
+ value => shift,
+ type => 'hidden',
+ @_
+ );
+ }
+ );
- # Attributes
- my %attrs = @_;
+ # Add "input_tag" helper
+ $app->helper(input_tag => sub { $self->_input(@_) });
- # Checkbox
- if (($attrs{type} || '') eq 'checkbox') {
- $attrs{checked} = 'checked';
- }
+ # Add "javascript" helper
+ $app->helper(
+ javascript => sub {
+ my $c = shift;
- # Other
- else { $attrs{value} = $p }
+ # CDATA
+ my $cb;
+ my $old = $cb = pop if ref $_[-1] && ref $_[-1] eq 'CODE';
+ $cb = sub { '<![CDATA[' . $old->() . ']]>' }
+ if $cb;
- return $self->_tag('input', name => $name, %attrs);
+ # Path
+ if (@_ % 2 ? ref $_[-1] ne 'CODE' : ref $_[-1] eq 'CODE') {
+ return $self->_tag(
+ 'script',
+ src => shift,
+ type => 'text/javascript',
+ @_
+ );
}
- # Empty tag
- $self->_tag('input', name => $name, @_);
+ # Block
+ $self->_tag('script', type => 'text/javascript', @_, $cb);
}
);
- # Add "label" helper
- $app->renderer->add_helper(
- label => sub { shift; $self->_tag('label', for => shift, @_) });
-
# Add "link_to" helper
- $app->renderer->add_helper(
+ $app->helper(
link_to => sub {
+ my $c = shift;
+ my $content = shift;
+ my @url = ($content);
+
+ # Content
+ unless (defined $_[-1] && ref $_[-1] eq 'CODE') {
+ @url = (shift);
+ push @_, sub {$content}
+ }
+
+ # Captures
+ push @url, shift if ref $_[0] eq 'HASH';
+
+ $self->_tag('a', href => $c->url_for(@url), @_);
+ }
+ );
+
+ # Add "password_field" helper
+ $app->helper(
+ password_field => sub {
my $c = shift;
my $name = shift;
+ $self->_tag('input', name => $name, type => 'password', @_);
+ }
+ );
- # Captures
- my $captures = ref $_[0] eq 'HASH' ? shift : {};
+ # Add "radio_button" helper
+ $app->helper(
+ radio_button => sub {
+ $self->_input(shift, shift, value => shift, @_, type => 'radio');
+ }
+ );
+
+ # Add "select_field" helper
+ $app->helper(
+ select_field => sub {
+ my $c = shift;
+ my $name = shift;
+ my $options = shift;
+ my %attrs = @_;
+
+ # Values
+ my %v = map { $_, 1 } $c->param($name);
+
+ # Callback
+ my $cb = sub {
- # Default content
- push @_, sub { ucfirst $name }
- unless defined $_[-1] && ref $_[-1] eq 'CODE';
+ # Pair
+ my $pair = shift;
+ $pair = [$pair, $pair] unless ref $pair eq 'ARRAY';
- $self->_tag('a', href => $c->url_for($name, $captures), @_);
+ # Attributes
+ my %attrs = (value => $pair->[1]);
+ $attrs{selected} = 'selected' if exists $v{$pair->[1]};
+
+ # Option tag
+ $self->_tag('option', %attrs, sub { $pair->[0] });
+ };
+
+ return $self->_tag(
+ 'select',
+ name => $name,
+ %attrs,
+ sub {
+
+ # Parts
+ my $parts = '';
+ for my $o (@$options) {
+
+ # OptGroup
+ if (ref $o eq 'ARRAY' && ref $o->[1] eq 'ARRAY') {
+ $parts .= $self->_tag(
+ 'optgroup',
+ label => $o->[0],
+ sub {
+ join '', map { $cb->($_) } @{$o->[1]};
+ }
+ );
+ }
+
+ # Option
+ else { $parts .= $cb->($o) }
+ }
+
+ return $parts;
+ }
+ );
}
);
- # Add "script" helper
- $app->renderer->add_helper(
- script => sub {
+ # Add "stylesheet" helper
+ $app->helper(
+ stylesheet => sub {
my $c = shift;
+ # CDATA
+ my $cb;
+ my $old = $cb = pop if ref $_[-1] && ref $_[-1] eq 'CODE';
+ $cb = sub { '<![CDATA[' . $old->() . ']]>' }
+ if $cb;
+
# Path
if (@_ % 2 ? ref $_[-1] ne 'CODE' : ref $_[-1] eq 'CODE') {
return $self->_tag(
- 'script',
- src => shift,
- type => 'text/javascript',
+ 'link',
+ href => shift,
+ media => 'screen',
+ rel => 'stylesheet',
+ type => 'text/css',
@_
);
}
# Block
- $self->_tag('script', type => 'text/javascript', @_);
+ $self->_tag('style', type => 'text/css', @_, $cb);
+ }
+ );
+
+ # Add "submit_button" helper
+ $app->helper(
+ submit_button => sub {
+ my $c = shift;
+ my $value = shift;
+ $value = 'Ok' unless defined $value;
+ $self->_tag('input', value => $value, type => 'submit', @_);
}
);
# Add "tag" helper
- $app->renderer->add_helper(tag => sub { shift; $self->_tag(@_) });
+ $app->helper(tag => sub { shift; $self->_tag(@_) });
+
+ # Add "text_area" helper
+ $app->helper(
+ text_area => sub {
+ my $c = shift;
+ my $name = shift;
+
+ # Value
+ my $cb = ref $_[-1] && ref $_[-1] eq 'CODE' ? pop : sub {''};
+ if (defined(my $value = $c->param($name))) {
+ $cb = sub {$value}
+ }
+
+ $self->_tag('textarea', name => $name, @_, $cb);
+ }
+ );
+
+ # Add "text_field" helper
+ $app->helper(text_field => sub { $self->_input(@_) });
+}
+
+sub _input {
+ my $self = shift;
+ my $c = shift;
+ my $name = shift;
+ my %attrs = @_;
+
+ # Value
+ my $p = $c->param($name);
+ $p = b($p)->xml_escape if defined $p;
+
+ my $t = $attrs{type} || '';
+ if (defined $p && $t ne 'submit') {
+
+ # Checkbox
+ if ($t eq 'checkbox') {
+ $attrs{checked} = 'checked';
+ }
+
+ # Radiobutton
+ elsif ($t eq 'radio') {
+ my $value = $attrs{value};
+ $value = '' unless defined $value;
+ $attrs{checked} = 'checked' if $value eq $p;
+ }
+
+ # Other
+ else { $attrs{value} = $p }
+
+ return $self->_tag('input', name => $name, %attrs);
+ }
+
+ # Empty tag
+ $self->_tag('input', name => $name, %attrs);
}
+# We’ve lost power of the forward Gameboy! Mario not responding!
sub _tag {
my $self = shift;
my $name = shift;
@@ -131,7 +307,7 @@ sub _tag {
else { $tag .= ' />' }
# Prevent escaping
- return Mojo::ByteStream->new($tag);
+ return b($tag);
}
1;
@@ -159,69 +335,231 @@ Note that this module is EXPERIMENTAL and might change without warning!
=over 4
+=item check_box
+
+ <%= check_box employed => 1 %>
+ <%= check_box employed => 1, id => 'foo' %>
+
+Generate checkbox input element.
+
+ <input name="employed" type="checkbox" value="1" />
+ <input id="foo" name="employed" type="checkbox" value="1" />
+
+=item file_field
+
+ <%= file_field 'avatar' %>
+ <%= file_field 'avatar', id => 'foo' %>
+
+Generate file input element.
+
+ <input name="avatar" type="file" />
+ <input id="foo" name="avatar" type="file" />
+
=item form_for
- <%= form_for login => (method => 'post') => {%>
- <%= input 'first_name' %>
- <%}%>
- <%= form_for login => {foo => 'bar'} => (method => 'post') => {%>
- <%= input 'first_name' %>
- <%}%>
- <%= form_for '/login' => (method => 'post') => {%>
- <%= input 'first_name' %>
- <%}%>
- <%= form_for 'http://mojolicious.org/login' => (method => 'post') => {%>
- <%= input 'first_name' %>
- <%}%>
+ <%= form_for login => (method => 'post') => begin %>
+ <%= text_field 'first_name' %>
+ <%= submit_button %>
+ <% end %>
+ <%= form_for login => {foo => 'bar'} => (method => 'post') => begin %>
+ <%= text_field 'first_name' %>
+ <%= submit_button %>
+ <% end %>
+ <%= form_for '/login' => (method => 'post') => begin %>
+ <%= text_field 'first_name' %>
+ <%= submit_button %>
+ <% end %>
+ <%= form_for 'http://kraih.com/login' => (method => 'post') => begin %>
+ <%= text_field 'first_name' %>
+ <%= submit_button %>
+ <% end %>
Generate form for route, path or URL.
-=item img
+ <form action="/path/to/login" method="post">
+ <input name="first_name" />
+ <input value="Ok" type="submit" />
+ </form>
+ <form action="/path/to/login/bar" method="post">
+ <input name="first_name" />
+ <input value="Ok" type="submit" />
+ </form>
+ <form action="/login" method="post">
+ <input name="first_name" />
+ <input value="Ok" type="submit" />
+ </form>
+ <form action="http://kraih.com/login" method="post">
+ <input name="first_name" />
+ <input value="Ok" type="submit" />
+ </form>
+
+=item hidden_field
+
+ <%= hidden_field foo => 'bar' %>
+ <%= hidden_field foo => 'bar', id => 'bar' %>
- <%= img '/foo.jpg' %>
- <%= img '/foo.jpg', alt => 'Image' %>
+Generate hidden input element.
-Generate image tag.
+ <input name="foo" type="hidden" value="bar" />
+ <input id="bar" name="foo" type="hidden" value="bar" />
-=item input
+=item input_tag
- <%= input 'first_name' %>
- <%= input 'first_name', value => 'Default name' %>
+ <%= input_tag 'first_name' %>
+ <%= input_tag 'first_name', value => 'Default name' %>
+ <%= input_tag 'employed', type => 'checkbox' %>
+ <%= input_tag 'country', type => 'radio', value => 'germany' %>
Generate form input element.
-=item label
+ <input name="first_name" />
+ <input name="first_name" value="Default name" />
+ <input name="employed" type="checkbox" />
+ <input name="country" type="radio" value="germany" />
- <%= label first_name => {%>First name<%}%>
+=item javascript
-Generate form label.
+ <%= javascript 'script.js' %>
+ <%= javascript begin %>
+ var a = 'b';
+ <% end %>
+
+Generate script tag for C<Javascript> asset.
+
+ <script src="script.js" type="text/javascript" />
+ <script type="text/javascript"><![CDATA[
+ var a = 'b';
+ ]]></script>
=item link_to
- <%= link_to index => {%>Home<%}%>
- <%= link_to index => {foo => 'bar'} => (class => 'links') => {%>Home<%}%>
- <%= link_to '/path/to/file' => {%>File<%}%>
- <%= link_to 'http://mojolicious.org' => {%>Mojolicious<%}%>
+ <%= link_to Home => 'index' %>
+ <%= link_to index => begin %>Home<% end %>
+ <%= link_to index => {foo => 'bar'} => (class => 'links') => begin %>
+ Home
+ <% end %>
+ <%= link_to '/path/to/file' => begin %>File<% end %>
+ <%= link_to 'http://mojolicious.org' => begin %>Mojolicious<% end %>
+ <%= link_to url_for->query(foo => $foo) => begin %>Retry<% end %>
-Generate link to route, path or URL.
+Generate link to route, path or URL, by default the capitalized link target
+will be used as content.
-=item script
+ <a href="/path/to/index">Home</a>
+ <a href="/path/to/index">Home</a>
+ <a class="links" href="/path/to/index/bar">Home</a>
+ <a href="/path/to/file">File</a>
+ <a href="http://mojolicious.org">Mojolicious</a>
+ <a href="/current/path?foo=something">Retry</a>
- <%= script '/script.js' %>
- <%= script {%>
- var a = 'b';
- <%}%>
+=item password_field
+
+ <%= password_field 'pass' %>
+ <%= password_field 'pass', id => 'foo' %>
+
+Generate password input element.
+
+ <input name="pass" type="password" />
+ <input id="foo" name="pass" type="password" />
+
+=item radio_button
+
+ <%= radio_button country => 'germany' %>
+ <%= radio_button country => 'germany', id => 'foo' %>
+
+Generate radio input element.
+
+ <input name="country" type="radio" value="germany" />
+ <input id="foo" name="country" type="radio" value="germany" />
+
+=item select_field
+
+ <%= select_field language => [qw/de en/] %>
+ <%= select_field language => [qw/de en/], id => 'lang' %>
+ <%= select_field country => [[Germany => 'de'], 'en'] %>
+ <%= select_field country => [[Europe => [Germany => 'de']]] %>
+
+Generate select, option and optgroup elements.
+
+ <select name="language">
+ <option name="de">de</option>
+ <option name="en">en</option>
+ </select>
+ <select id="lang" name="language">
+ <option name="de">de</option>
+ <option name="en">en</option>
+ </select>
+ <select name="country">
+ <option name="de">Germany</option>
+ <option name="en">en</option>
+ </select>
+ <select id="lang" name="language">
+ <optgroup label="Europe">
+ <option name="de">Germany</option>
+ <option name="en">en</option>
+ </optgroup>
+ </select>
+
+=item stylesheet
+
+ <%= stylesheet 'foo.css %>
+ <%= stylesheet begin %>
+ body {color: #000}
+ <% end %>
-Generate script tag.
+Generate style or link tag for C<CSS> asset.
+
+ <link href="foo.css" media="screen" rel="stylesheet" type="text/css" />
+ <style type="text/css"><![CDATA[
+ body {color: #000}
+ ]]></style>
+
+=item submit_button
+
+ <%= submit_button %>
+ <%= submit_button 'Ok!', id => 'foo' %>
+
+Generate submit input element.
+
+ <input type="submit" value="Ok" />
+ <input id="foo" type="submit" value="Ok!" />
=item tag
<%= tag 'div' %>
<%= tag 'div', id => 'foo' %>
- <%= tag div => {%>Content<%}%>
+ <%= tag div => begin %>Content<% end %>
HTML5 tag generator.
+ <div />
+ <div id="foo" />
+ <div>Content</div>
+
+=item text_field
+
+ <%= text_field 'first_name' %>
+ <%= text_field 'first_name', value => 'Default name' %>
+
+Generate text input element.
+
+ <input name="first_name" />
+ <input name="first_name" value="Default name" />
+
+=item text_area
+
+ <%= text_area 'foo' %>
+ <%= text_area foo => begin %>
+ Default!
+ <% end %>
+
+Generate textarea element.
+
+ <textarea name="foo"></textarea>
+ <textarea name="foo">
+ Default!
+ </textarea>
+
=back
=head1 METHODS
@@ -25,43 +25,48 @@ sub add_hook {
return $self;
}
+# Also you have a rectangular object in your colon.
+# That's a calculator. I ate it to gain its power.
sub load_plugin {
- my $self = shift;
-
- # Application
- my $app = shift;
- return unless $app;
-
- # Class
- my $name = shift;
- return unless $name;
- my $class = b($name)->camelize->to_string;
+ my ($self, $name) = @_;
- # Arguments
- my $args = ref $_[0] ? $_[0] : {@_};
+ # Module
+ if ($name =~ /^[A-Z]+/) { return $name->new if $self->_load($name) }
- # Try all namspaces
- for my $namespace (@{$self->namespaces}) {
+ # Search plugin by name
+ else {
- # Module
- my $module = "${namespace}::$class";
+ # Class
+ my $class = b($name)->camelize->to_string;
- # Load
- my $e = Mojo::Loader->load($module);
- if (ref $e) { die $e }
- next if $e;
+ # Try all namspaces
+ for my $namespace (@{$self->namespaces}) {
- # Module is a plugin
- next unless $module->can('new') && $module->can('register');
+ # Module
+ my $module = "${namespace}::$class";
- # Register
- return $module->new->register($app, $args);
+ # Load and register
+ return $module->new if $self->_load($module);
+ }
}
# Not found
die qq/Plugin "$name" missing, maybe you need to install it?\n/;
}
+# Let's see how crazy I am now, Nixon. The correct answer is very.
+sub register_plugin {
+ my $self = shift;
+ my $name = shift;
+ my $app = shift;
+
+ # Arguments
+ my $args = ref $_[0] ? $_[0] : {@_};
+
+ # Register
+ return $self->load_plugin($name)->register($app, $args);
+}
+
sub run_hook {
my $self = shift;
@@ -70,12 +75,13 @@ sub run_hook {
return $self unless $name;
return unless $self->hooks->{$name};
- # Run
+ # DEPRECATED in Hot Beverage! (passing $self)
for my $hook (@{$self->hooks->{$name}}) { $self->$hook(@_) }
return $self;
}
+# Everybody's a jerk. You, me, this jerk.
sub run_hook_reverse {
my $self = shift;
@@ -84,12 +90,25 @@ sub run_hook_reverse {
return $self unless $name;
return unless $self->hooks->{$name};
- # Run
+ # DEPRECATED in Hot Beverage! (passing $self)
for my $hook (reverse @{$self->hooks->{$name}}) { $self->$hook(@_) }
return $self;
}
+sub _load {
+ my ($self, $module) = @_;
+
+ # Load
+ my $e = Mojo::Loader->load($module);
+ if (ref $e) { die $e }
+ return if $e;
+
+ # Module is a plugin
+ return unless $module->can('new') && $module->can('register');
+ return 1;
+}
+
1;
__END__
@@ -138,62 +157,30 @@ implements the following new ones.
$plugins = $plugins->add_hook(event => sub {...});
Hook into an event.
-The following events are available.
-(Note that C<after_*> hooks run in reverse order)
-
-=over 4
-
-=item before_dispatch
-
-Runs before the dispatchers determines what action to run.
-(Passed the default controller instance)
-
- $plugins->add_hook(before_dispatch => sub {
- my ($self, $c) = @_;
- });
-
-=item after_dispatch
-
-Runs after the dispatchers determines what action to run.
-(Passed the default controller instance)
+You can also add custom events by calling C<run_hook> and C<run_hook_reverse>
+from your application.
- $plugins->add_hook(after_dispatch => sub {
- my ($self, $c) = @_;
- });
-
-=item after_static_dispatch
-
-Runs after the static dispatcher determines if a static file should be
-served. (Passed the default controller instance)
-
- $plugins->add_hook(after_static_dispatch => sub {
- my ($self, $c) = @_;
- })
-
-=item after_build_tx
-
-Runs right after the transaction is built and before the HTTP message gets
-parsed.
-One usage case would be upload progress bars.
-(Passed the transaction instance)
-
- $plugins->add_hook(after_build_tx => sub {
- my ($self, $tx) = @_;
- })
+=head2 C<load_plugin>
-=back
+ my $plugin = $plugins->load_plugin('something');
+ my $plugin = $plugins->load_plugin('Foo::Bar');
-You could also add custom events by using C<run_hook> and C<run_hook_reverse>
-in your application.
+Load a plugin from the configured namespaces or by full module name.
+Note that this method is EXPERIMENTAL and might change without warning!
-=head2 C<load_plugin>
+=head2 C<register_plugin>
- $plugins = $plugins->load_plugin($app, 'something');
- $plugins = $plugins->load_plugin($app, 'something', foo => 23);
- $plugins = $plugins->load_plugin($app, 'something', {foo => 23});
+ $plugins->register_plugin('something', $app);
+ $plugins->register_plugin('something', $app, foo => 23);
+ $plugins->register_plugin('something', $app, {foo => 23});
+ $plugins->register_plugin('Foo::Bar', $app);
+ $plugins->register_plugin('Foo::Bar', $app, foo => 23);
+ $plugins->register_plugin('Foo::Bar', $app, {foo => 23});
-Load a plugin from the configured namespaces and run C<register>.
+Load a plugin from the configured namespaces or by full module name and run
+C<register>.
Optional arguments are passed to register.
+Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<run_hook>
@@ -5,6 +5,7 @@ use warnings;
use base 'Mojo';
+use Carp 'croak';
use Mojolicious::Commands;
use Mojolicious::Plugins;
use MojoX::Dispatcher::Routes;
@@ -33,8 +34,38 @@ __PACKAGE__->attr(session => sub { MojoX::Session::Cookie->new });
__PACKAGE__->attr(static => sub { MojoX::Dispatcher::Static->new });
__PACKAGE__->attr(types => sub { MojoX::Types->new });
-our $CODENAME = 'Comet';
-our $VERSION = '0.999929';
+our $CODENAME = 'Hot Beverage';
+our $VERSION = '0.999933';
+
+our $AUTOLOAD;
+
+# These old doomsday devices are dangerously unstable.
+# I'll rest easier not knowing where they are.
+sub AUTOLOAD {
+ my $self = shift;
+
+ # Method
+ my ($package, $method) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
+
+ # Helper
+ croak qq/Can't locate object method "$method" via "$package"/
+ unless my $helper = $self->renderer->helper->{$method};
+
+ # Load controller class
+ my $class = $self->controller_class;
+ if (my $e = Mojo::Loader->load($class)) {
+ $self->log->error(
+ ref $e
+ ? qq/Can't load controller class "$class": $e/
+ : qq/Controller class "$class" doesn't exist./
+ );
+ }
+
+ # Run
+ return $class->new(app => $self)->$helper(@_);
+}
+
+sub DESTROY { }
# I personalized each of your meals.
# For example, Amy: you're cute, so I baked you a pony.
@@ -42,7 +73,7 @@ sub new {
my $self = shift->SUPER::new(@_);
# Transaction builder
- $self->build_tx_cb(
+ $self->on_build_tx(
sub {
my $self = shift;
@@ -50,7 +81,7 @@ sub new {
my $tx = Mojo::Transaction::HTTP->new;
# Hook
- $self->plugins->run_hook_reverse(after_build_tx => $tx);
+ $self->plugins->run_hook(after_build_tx => ($tx, $self));
return $tx;
}
@@ -80,11 +111,12 @@ sub new {
$static->root($home->rel_dir('public'));
# Hide own controller methods
- $r->hide(qw/client cookie finish finished flash handler helper param/);
- $r->hide(qw/pause receive_message redirect_to render render_data/);
- $r->hide(qw/render_exception render_inner render_json render_not_found/);
- $r->hide(qw/render_partial render_static render_text resume/);
- $r->hide(qw/send_message session signed_cookie url_for/);
+ $r->hide(qw/AUTOLOAD DESTROY client cookie finish finished flash/);
+ $r->hide(qw/handler helper on_message param redirect_to render/);
+ $r->hide(qw/render_data render_exception render_inner render_json/);
+ $r->hide(qw/render_not_found render_partial render_static render_text/);
+ $r->hide(qw/rendered send_message session signed_cookie url_for/);
+ $r->hide(qw/write write_chunk/);
# Mode
my $mode = $self->mode;
@@ -115,6 +147,8 @@ sub new {
return $self;
}
+# Amy, technology isn't intrinsically good or evil. It's how it's used.
+# Like the Death Ray.
sub defaults {
my $self = shift;
@@ -168,28 +202,6 @@ sub dispatch {
# Nothing found
$c->render_not_found unless $c->res->code;
}
-
- # Finish
- $self->finish($c);
-}
-
-sub finish {
- my ($self, $c) = @_;
-
- # Already finished
- return if $c->stash->{finished};
-
- # Paused
- return if $c->tx->is_paused;
-
- # Hook
- $self->plugins->run_hook_reverse(after_dispatch => $c);
-
- # Session
- $self->session->store($c);
-
- # Finished
- $c->stash->{finished} = 1;
}
# Bite my shiny metal ass!
@@ -221,12 +233,27 @@ sub handler {
eval {
$self->process($class->new(app => $self, stash => $stash, tx => $tx));
};
- $self->log->error("Processing request failed: $@") if $@;
+
+ # Fatal exception
+ if ($@) {
+ $self->log->fatal("Processing request failed: $@");
+ $tx->res->code(500);
+ $tx->resume;
+ }
+}
+
+sub helper { shift->renderer->add_helper(@_) }
+
+sub hook {
+ my ($self, $name, $cb) = @_;
+
+ # DEPRECATED in Hot Beverage! (callback wrapper)
+ $self->plugins->add_hook($name, sub { shift; $cb->(@_) });
}
sub plugin {
my $self = shift;
- $self->plugins->load_plugin($self, @_);
+ $self->plugins->register_plugin(shift, $self, @_);
}
# This will run for each request
@@ -302,6 +329,8 @@ art technology.
=over 4
+=item *
+
An amazing MVC web framework supporting a simplified single file mode through
L<Mojolicious::Lite>.
@@ -313,19 +342,31 @@ I18N, first class unicode support and much more for you to discover.
=back
+=item *
+
Very clean, portable and Object Oriented pure Perl API without any hidden
magic and no requirements besides Perl 5.8.7.
+=item *
+
Full stack HTTP 1.1 and WebSocket client/server implementation with IPv6,
-TLS, Bonjour, IDNA, chunking and multipart support.
+TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
+
+=item *
+
+Builtin async IO web server supporting epoll, kqueue, UNIX domain sockets and
+hot deployment, perfect for embedding.
-Builtin async IO and prefork web server supporting epoll, kqueue, hot
-deployment and UNIX domain socket sharing, perfect for embedding.
+=item *
Automatic CGI, FastCGI and L<PSGI> detection.
+=item *
+
JSON and XML/HTML5 parser with CSS3 selector support.
+=item *
+
Fresh code based upon years of experience developing L<Catalyst>.
=back
@@ -342,7 +383,7 @@ Web development for humans, making hard things possible and everything fun.
websocket '/echo' => sub {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$self->send_message("echo: $message");
@@ -368,13 +409,17 @@ Web development for humans, making hard things possible and everything fun.
@@ clock.html.ep
% my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ <%= link_to clock => begin %>
+ The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ <% end %>
For more user friendly documentation see L<Mojolicious::Guides> and
L<Mojolicious::Lite>.
=head2 Have Some Cake
+Loosely coupled building blocks, use what you like and just ignore the rest.
+
.---------------------------------------------------------------.
| Fun! |
'---------------------------------------------------------------'
@@ -401,16 +446,16 @@ following new ones.
=head2 C<controller_class>
- my $class = $mojo->controller_class;
- $mojo = $mojo->controller_class('Mojolicious::Controller');
+ my $class = $app->controller_class;
+ $app = $app->controller_class('Mojolicious::Controller');
Class to be used for the default controller, defaults to
L<Mojolicious::Controller>.
=head2 C<mode>
- my $mode = $mojo->mode;
- $mojo = $mojo->mode('production');
+ my $mode = $app->mode;
+ $app = $app->mode('production');
The operating mode for your application.
It defaults to the value of the environment variable C<MOJO_MODE> or
@@ -431,8 +476,8 @@ to your application named C<$mode_mode>.
=head2 C<plugins>
- my $plugins = $mojo->plugins;
- $mojo = $mojo->plugins(Mojolicious::Plugins->new);
+ my $plugins = $app->plugins;
+ $app = $app->plugins(Mojolicious::Plugins->new);
The plugin loader, by default a L<Mojolicious::Plugins> object.
You can usually leave this alone, see L<Mojolicious::Plugin> if you want to
@@ -440,8 +485,8 @@ write a plugin.
=head2 C<renderer>
- my $renderer = $mojo->renderer;
- $mojo = $mojo->renderer(MojoX::Renderer->new);
+ my $renderer = $app->renderer;
+ $app = $app->renderer(MojoX::Renderer->new);
Used in your application to render content, by default a L<MojoX::Renderer>
object.
@@ -450,8 +495,8 @@ L<Mojolicious::Plugin::EplRenderer> contain more specific information.
=head2 C<routes>
- my $routes = $mojo->routes;
- $mojo = $mojo->routes(MojoX::Dispatcher::Routes->new);
+ my $routes = $app->routes;
+ $app = $app->routes(MojoX::Dispatcher::Routes->new);
The routes dispatcher, by default a L<MojoX::Dispatcher::Routes> object.
You use this in your startup method to define the url endpoints for your
@@ -466,8 +511,8 @@ application.
=head2 C<secret>
- my $secret = $mojo->secret;
- $mojo = $mojo->secret('passw0rd');
+ my $secret = $app->secret;
+ $app = $app->secret('passw0rd');
A secret passphrase used for signed cookies and the like, defaults to the
application name which is not very secure, so you should change it!!!
@@ -476,22 +521,22 @@ the log file reminding you to change your passphrase.
=head2 C<static>
- my $static = $mojo->static;
- $mojo = $mojo->static(MojoX::Dispatcher::Static->new);
+ my $static = $app->static;
+ $app = $app->static(MojoX::Dispatcher::Static->new);
For serving static assets from your C<public> directory, by default a
L<MojoX::Dispatcher::Static> object.
=head2 C<types>
- my $types = $mojo->types;
- $mojo = $mojo->types(MojoX::Types->new);
+ my $types = $app->types;
+ $app = $app->types(MojoX::Types->new);
Responsible for tracking the types of content you want to serve in your
application, by default a L<MojoX::Types> object.
You can easily register new types.
- $mojo->types->type(vti => 'help/vampire');
+ $app->types->type(vti => 'help/vampire');
=head1 METHODS
@@ -500,7 +545,7 @@ new ones.
=head2 C<new>
- my $mojo = Mojolicious->new;
+ my $app = Mojolicious->new;
Construct a new L<Mojolicious> application.
Will automatically detect your home directory and set up logging based on
@@ -509,51 +554,120 @@ Also sets up the renderer, static dispatcher and a default set of plugins.
=head2 C<defaults>
- my $defaults = $mojo->default;
- my $foo = $mojo->defaults('foo');
- $mojo = $mojo->defaults({foo => 'bar'});
- $mojo = $mojo->defaults(foo => 'bar');
+ my $defaults = $app->defaults;
+ my $foo = $app->defaults('foo');
+ $app = $app->defaults({foo => 'bar'});
+ $app = $app->defaults(foo => 'bar');
Default values for the stash.
Note that this method is EXPERIMENTAL and might change without warning!
- $mojo->defaults->{foo} = 'bar';
- my $foo = $mojo->defaults->{foo};
- delete $mojo->defaults->{foo};
+ $app->defaults->{foo} = 'bar';
+ my $foo = $app->defaults->{foo};
+ delete $app->defaults->{foo};
=head2 C<dispatch>
- $mojo->dispatch($c);
+ $app->dispatch($c);
The heart of every Mojolicious application, calls the static and routes
-dispatchers for every request.
+dispatchers for every request and passes them a L<Mojolicious::Controller>
+object.
-=head2 C<finish>
+=head2 C<handler>
- $mojo->finish($c);
+ $tx = $app->handler($tx);
-Clean up after processing a request, usually called automatically.
+Sets up the default controller and calls process for every request.
-=head2 C<handler>
+=head2 C<helper>
- $tx = $mojo->handler($tx);
+ $app->helper(foo => sub { ... });
-Sets up the default controller and calls process for every request.
+Add a new helper.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+ # Helper
+ $app->helper(add => sub { $_[1] + $_[2] });
+
+ # Controller/Application
+ my $result = $self->add(2, 3);
+
+ # Template
+ <%= add 2, 3 %>
+
+=head2 C<hook>
+
+ $app->hook(after_dispatch => sub { ... });
+
+Add hooks to named events.
+Note that this method is EXPERIMENTAL and might change without warning!
+
+The following events are available and run in the listed order.
+
+=over 4
+
+=item after_build_tx
+
+Triggered right after the transaction is built and before the HTTP request
+gets parsed.
+One use case would be upload progress bars.
+(Passed the transaction and application instances)
+
+ $app->hook(before_request => sub {
+ my ($tx, $app) = @_;
+ });
+
+=item before_dispatch
+
+Triggered right before the static and routes dispatchers start their work.
+(Passed the default controller instance)
+
+ $app->hook(before_dispatch => sub {
+ my $self = shift;
+ });
+
+=item after_static_dispatch
+
+Triggered after the static dispatcher determined if a static file should be
+served and before the routes dispatcher starts its work, the callbacks of
+this hook run in reverse order.
+(Passed the default controller instance)
+
+ $app->hook(after_static_dispatch => sub {
+ my $self = shift;
+ });
+
+=item after_dispatch
+
+Triggered after the static and routes dispatchers are finished and a response
+has been rendered, the callbacks of this hook run in reverse order.
+(Passed the current controller instance)
+
+ $app->hook(after_dispatch => sub {
+ my $self = shift;
+ });
+
+=back
=head2 C<plugin>
- $mojo->plugin('something');
- $mojo->plugin('something', foo => 23);
- $mojo->plugin('something', {foo => 23});
+ $app->plugin('something');
+ $app->plugin('something', foo => 23);
+ $app->plugin('something', {foo => 23});
+ $app->plugin('Foo::Bar');
+ $app->plugin('Foo::Bar', foo => 23);
+ $app->plugin('Foo::Bar', {foo => 23});
Load a plugin.
+Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<process>
- $mojo->process($c);
+ $app->process($c);
This method can be overloaded to do logic on a per request basis, by default
-just calls dispatch.
+just calls dispatch and passes it a L<Mojolicious::Controller> object.
Generally you will use a plugin or controller instead of this, consider it
the sledgehammer in your toolbox.
@@ -572,7 +686,7 @@ application.
=head2 C<startup>
- $mojo->startup;
+ $app->startup;
This is your main hook into the application, it will be called at application
startup.
@@ -601,6 +715,17 @@ startup.
http://github.com/kraih/mojo
+=head1 CODE NAMES
+
+Every major release of L<Mojolicious> has a code name, these are the ones
+that have been used in the past.
+
+0.999930, C<Hot Beverage> (u2615)
+
+0.999927, C<Comet> (u2604)
+
+0.999920, C<Snowman> (u2603)
+
=head1 AUTHOR
Sebastian Riedel, C<sri@cpan.org>.
@@ -645,6 +770,8 @@ Burak Gursoy
Ch Lamprecht
+Chas. J. Owens IV
+
Christian Hansen
Curt Tilmes
@@ -653,6 +780,8 @@ Danijel Tasov
David Davis
+Dmitriy Shalashov
+
Dmitry Konstantinov
Eugene Toropov
@@ -667,6 +796,8 @@ Hideki Yamamura
James Duncan
+Jan Jona Javorsek
+
Jaroslav Muhin
Jesse Vincent
@@ -697,10 +828,14 @@ Maxim Vuets
Mirko Westermeier
+Mons Anderson
+
Oleg Zhelo
Pascal Gaudette
+Paul Tomlin
+
Pedro Melo
Peter Edwards
@@ -721,6 +856,8 @@ Sascha Kiefer
Sergey Zasenko
+Simon Bertrang
+
Shu Cho
Stanis Trendelenburg
@@ -731,6 +868,8 @@ The Perl Foundation
Tomas Znamenacek
+Ulrich Habel
+
Ulrich Kautz
Uwe Voelker
@@ -1,398 +0,0 @@
-package Test::Mojo::Server;
-
-use strict;
-use warnings;
-
-use base 'Mojo::Base';
-
-use File::Spec;
-use FindBin;
-use IO::Socket::INET;
-use Mojo::Command;
-use Mojo::IOLoop;
-use Mojo::Home;
-
-require Test::More;
-
-use constant DEBUG => $ENV{MOJO_SERVER_DEBUG} || 0;
-
-__PACKAGE__->attr([qw/command pid/]);
-__PACKAGE__->attr(delay => 1);
-__PACKAGE__->attr(executable => 'mojo');
-__PACKAGE__->attr(home => sub { Mojo::Home->new });
-__PACKAGE__->attr(port => sub { Mojo::IOLoop->singleton->generate_port });
-__PACKAGE__->attr(timeout => 5);
-
-# Hello, my name is Barney Gumble, and I'm an alcoholic.
-# Mr Gumble, this is a girl scouts meeting.
-# Is it, or is it you girls can't admit that you have a problem?
-sub find_executable_ok {
- my $self = shift;
- my $path = $self->_find_executable;
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- Test::More::ok($path ? 1 : 0, 'executable found');
- return $path;
-}
-
-sub generate_port_ok {
- my $self = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- my $port = Mojo::IOLoop->singleton->generate_port;
- if ($port) {
- Test::More::ok(1, 'port generated');
- return $port;
- }
-
- Test::More::ok(0, 'port generated');
- return;
-}
-
-sub server_ok {
- my $self = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- # Not running
- unless ($self->port) {
- return Test::More::ok(0, 'server still running');
- }
-
- # Test
- my $ok = $self->_check_server(1) ? 1 : 0;
- Test::More::ok($ok, 'server still running');
-}
-
-sub start_daemon_ok {
- my $self = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- # Port
- my $port = $self->port;
- return Test::More::ok(0, 'server started') unless $port;
-
- # Path
- my $path = $self->_find_executable;
- return Test::More::ok(0, 'server started') unless $path;
-
- # Prepare command
- $self->command([$^X, $path, 'daemon', '--listen', "http:\/\/*:$port"]);
-
- return $self->start_server_ok;
-}
-
-sub start_daemon_prefork_ok {
- my $self = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- # Port
- my $port = $self->port;
- return Test::More::ok(0, 'server started') unless $port;
-
- # Path
- my $path = $self->_find_executable;
- return Test::More::ok(0, 'server started') unless $path;
-
- # Prepare command
- $self->command(
- [$^X, $path, 'daemon_prefork', '--listen', "http:\/\/*:$port"]);
-
- return $self->start_server_ok;
-}
-
-sub start_server_ok {
- my $self = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- # Start server
- my $pid = $self->_start_server;
- return Test::More::ok(0, 'server started') unless $pid;
-
- # Wait for server
- my $timeout = $self->timeout;
- my $time_before = time;
- while (!$self->_check_server) {
-
- # Timeout
- $timeout -= time - $time_before;
- if ($timeout <= 0) {
- $self->_stop_server;
- return Test::More::ok(0, 'server started');
- }
-
- # Wait
- sleep 1;
- }
-
- # Done
- Test::More::ok(1, 'server started');
-
- return $self->port;
-}
-
-sub start_server_untested_ok {
- my $self = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- # Start server
- my $pid = $self->_start_server;
- return Test::More::ok(0, 'server started') unless $pid;
-
- # Done
- Test::More::ok(1, 'server started');
-
- return $self->port;
-}
-
-sub stop_server_ok {
- my $self = shift;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
-
- # Running
- unless ($self->pid && kill 0, $self->pid) {
- return Test::More::ok(0, 'server stopped');
- }
-
- # Debug
- if (DEBUG) {
- sysread $self->{_server}, my $buffer, 262144;
- warn "\nSERVER STDOUT: $buffer\n";
- }
-
- # Stop server
- $self->_stop_server();
-
- # Give it a few seconds to stop
- foreach (1 .. $self->timeout) {
- if ($self->_check_server) {
- sleep 1;
- }
- else {
- Test::More::ok(1, 'server stopped');
- return;
- }
- }
- Test::More::ok(0, 'server stopped');
-}
-
-sub _check_server {
- my $self = shift;
-
- # Delay
- my $delay = $self->delay;
- sleep $delay if $delay;
-
- # Create socket
- my $server = IO::Socket::INET->new(
- Proto => 'tcp',
- PeerAddr => 'localhost',
- PeerPort => $self->port
- );
-
- # Close socket
- if ($server) {
- close $server;
- return 1;
- }
-
- return;
-}
-
-sub _find_executable {
- my $self = shift;
-
- # Find
- my @base = File::Spec->splitdir($FindBin::Bin);
- my $name = Mojo::Command->new->class_to_path($self->home->app_class);
- my @uplevel;
- my $path;
- for (1 .. 5) {
- push @uplevel, '..';
-
- # App executable in script directory
- $path = File::Spec->catfile(@base, @uplevel, 'script', $name);
- last if -f $path;
-
- # Custom executable in script directory
- $path =
- File::Spec->catfile(@base, @uplevel, 'script', $self->executable);
- last if -f $path;
- }
-
- # Found
- return $path if -f $path;
-
- # Not found
- return;
-}
-
-sub _start_server {
- my $self = shift;
-
- # Command
- my $command = $self->command;
- my @command = ref $command eq 'ARRAY' ? @$command : $command;
-
- # Run server
- my $pid = open $self->{_server}, '-|', @command;
- $self->pid($pid);
-
- # Process started
- return unless $pid;
-
- $self->{_server}->blocking(0);
-
- return $pid;
-}
-
-sub _stop_server {
- my $self = shift;
-
- # Kill server portable
- kill $^O eq 'MSWin32' ? 'KILL' : 'INT', $self->pid;
- close $self->{_server};
- $self->pid(undef);
- delete $self->{_server};
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Test::Mojo::Server - Server Tests
-
-=head1 SYNOPSIS
-
- use Test::Mojo::Server;
-
- my $server = Test::Mojo::Server->new;
- $server->start_daemon_ok;
- $server->stop_server_ok;
-
-=head1 DESCRIPTION
-
-L<Test::Mojo::Server> is a collection of testing helpers specifically for
-developers of L<Mojo> server bindings.
-
-=head1 ATTRIBUTES
-
-L<Test::Mojo::Server> implements the following attributes.
-
-=head2 C<command>
-
- my $command = $server->command;
- $server = $server->command("/usr/sbin/httpd -X -f 'x.cfg'");
- $server = $server->command(['/usr/sbin/httpd', '-X', '-f', 'x.cfg']);
-
-Command for external server start.
-
-=head2 C<delay>
-
- my $delay = $server->delay;
- $server = $server->delay(2);
-
-Time to wait between server checks in seconds, defaults to C<1>.
-
-=head2 C<executable>
-
- my $script = $server->executable;
- $server = $server->executable('mojo');
-
-L<Mojo> executable name.
-
-=head2 C<home>
-
- my $home = $server->home;
- $server = $server->home(Mojo::Home->new);
-
-Home for application.
-
-=head2 C<pid>
-
- my $pid = $server->pid;
-
-Process id for external server.
-
-=head2 C<port>
-
- my $port = $server->port;
- $server = $server->port(3000);
-
-Server port.
-
-=head2 C<timeout>
-
- my $timeout = $server->timeout;
- $server = $server->timeout(5);
-
-Timeout for external server startup.
-
-=head1 METHODS
-
-L<Test::Mojo::Server> inherits all methods from L<Mojo::Base> and implements
-the following new ones.
-
-=head2 C<new>
-
- my $server = Test::Mojo::Server->new;
-
-Construct a new L<Test::Mojo::Server> object.
-
-=head2 C<find_executable_ok>
-
- my $path = $server->find_executable_ok;
-
-Try to find L<Mojo> executable.
-
-=head2 C<generate_port_ok>
-
- my $port = $server->generate_port_ok;
-
-=head2 C<server_ok>
-
- $server->server_ok;
-
-Check if server is still running.
-
-=head2 C<start_daemon_ok>
-
- my $port = $server->start_daemon_ok;
-
-Start external L<Mojo::Server::Daemon> server.
-
-=head2 C<start_daemon_prefork_ok>
-
- my $port = $server->start_daemon_prefork_ok;
-
-Start external L<Mojo::Server::Daemon::Prefork> server.
-
-=head2 C<start_server_ok>
-
- my $port = $server->start_server_ok;
-
-Start external server.
-
-=head2 C<start_server_untested_ok>
-
- my $port = $server->start_server_untested_ok;
-
-Start external server without testing the port.
-
-=head2 C<stop_server_ok>
-
- $server->stop_server_ok;
-
-Stop external server.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -16,6 +16,9 @@ __PACKAGE__->attr(client => sub { Mojo::Client->singleton });
__PACKAGE__->attr('tx');
__PACKAGE__->attr(max_redirects => 0);
+# Silent tests
+$ENV{MOJO_LOG_LEVEL} ||= 'fatal';
+
# Ooh, a graduate student huh?
# How come you guys can go to the moon but can't make my shoes smell good?
sub content_is {
@@ -112,7 +115,7 @@ sub header_is {
# Test
local $Test::Builder::Level = $Test::Builder::Level + 1;
- Test::More::is($tx->res->headers->header($name),
+ Test::More::is(scalar $tx->res->headers->header($name),
$value, "$name: " . ($value ? $value : ''));
return $self;
@@ -129,7 +132,7 @@ sub header_like {
# Test
local $Test::Builder::Level = $Test::Builder::Level + 1;
- Test::More::like($tx->res->headers->header($name), $regex, $desc);
+ Test::More::like(scalar $tx->res->headers->header($name), $regex, $desc);
return $self;
}
@@ -168,7 +171,7 @@ sub post_form_ok {
$client->max_redirects($self->max_redirects);
# Request
- $client->post_form(@_, sub { $self->tx($_[-1]) })->process;
+ $client->post_form(@_, sub { $self->tx($_[-1]) })->start;
# Test
local $Test::Builder::Level = $Test::Builder::Level + 1;
@@ -227,6 +230,9 @@ sub text_is {
return $self;
}
+# Hello, my name is Barney Gumble, and I'm an alcoholic.
+# Mr Gumble, this is a girl scouts meeting.
+# Is it, or is it you girls can't admit that you have a problem?
sub text_like {
my ($self, $selector, $regex, $desc) = @_;
@@ -279,7 +285,7 @@ sub _request_ok {
# Request
$client->$method($url, %$headers, $body, sub { $self->tx($_[-1]) })
- ->process;
+ ->start;
# Test
local $Test::Builder::Level = $Test::Builder::Level + 2;
@@ -398,7 +404,8 @@ Perform a C<DELETE> request.
$t = $t->element_exists('div.foo[x=y]');
$t = $t->element_exists('html head title', 'has a title');
-Checks for existence of the CSS3 selectors XML/HTML element.
+Checks for existence of the CSS3 selectors XML/HTML element with
+L<Mojo::DOM>.
Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<get_ok>
@@ -494,7 +501,8 @@ Check response status for exact match.
$t = $t->text_is('div.foo[x=y]' => 'Hello!');
$t = $t->text_is('html head title' => 'Hello!', 'right title');
-Checks text content of the CSS3 selectors XML/HTML element for exact match.
+Checks text content of the CSS3 selectors XML/HTML element for exact match
+with L<Mojo::DOM>.
Note that this method is EXPERIMENTAL and might change without warning!
=head2 C<text_like>
@@ -502,7 +510,8 @@ Note that this method is EXPERIMENTAL and might change without warning!
$t = $t->text_like('div.foo[x=y]' => qr/Hello/);
$t = $t->text_like('html head title' => qr/Hello/, 'right title');
-Checks text content of the CSS3 selectors XML/HTML element for similar match.
+Checks text content of the CSS3 selectors XML/HTML element for similar match
+with L<Mojo::DOM>.
Note that this method is EXPERIMENTAL and might change without warning!
=head1 SEE ALSO
@@ -7,6 +7,10 @@ use warnings;
# No I'm... doesn't.
use Mojo::ByteStream 'b';
use Mojo::Client;
+use Mojo::DOM;
+
+# Silent oneliners
+$ENV{MOJO_LOG_LEVEL} ||= 'fatal';
# I'm sorry, guys. I never meant to hurt you.
# Just to destroy everything you ever believed in.
@@ -32,21 +36,35 @@ sub import {
*{"${caller}::d"} = sub { _request('delete', @_) };
*{"${caller}::f"} = sub { _request('post_form', @_) };
*{"${caller}::g"} = sub { _request('get', @_) };
+ *{"${caller}::h"} = sub { _request('head', @_) };
*{"${caller}::p"} = sub { _request('post', @_) };
*{"${caller}::u"} = sub { _request('put', @_) };
- *{"${caller}::w"} =
- sub { Mojo::Client->singleton->websocket(@_)->process }
+ *{"${caller}::w"} = sub { Mojo::Client->singleton->websocket(@_)->start };
+ *{"${caller}::x"} = sub { Mojo::DOM->new->parse(@_) };
}
# I wonder what the shroud of Turin tastes like.
sub _request {
+
+ # Method
my $method = $_[0] =~ /:|\// ? 'get' : lc shift;
+
+ # Client
my $client = Mojo::Client->singleton;
+
+ # Transaction
my $tx =
$method eq 'post_form'
? $client->build_form_tx(@_)
: $client->build_tx($method, @_);
- $client->process($tx, sub { $tx = $_[1] });
+
+ # Process
+ $client->start($tx, sub { $tx = $_[1] });
+
+ # Error
+ my ($message, $code) = $tx->error;
+ warn qq/Couldn't open URL "$_[0]". ($message)\n/ if $message && !$code;
+
return $tx->res;
}
@@ -142,6 +160,19 @@ the C<MOJO_MAX_REDIRECTS> environment variable.
MOJO_MAX_REDIRECTS=0 perl -Mojo -e 'b(g("mojolicious.org")->code)->say'
+=head2 C<h>
+
+ my $res = h('http://mojolicio.us');
+ my $res = h('http://mojolicio.us', {'X-Bender' => 'X_x'});
+ my $res = h(
+ 'http://mojolicio.us',
+ {'Content-Type' => 'text/plain'},
+ 'Hello!'
+ );
+
+Perform C<HEAD> request and turn response into a L<Mojo::Message::Response>
+object.
+
=head2 C<p>
my $res = p('http://mojolicio.us');
@@ -174,6 +205,14 @@ object.
Open a WebSocket connection.
+=head2 C<x>
+
+ my $dom = x('<div>Hello!</div>');
+
+Turn HTML5/XML input into L<Mojo::DOM> object.
+
+ print x('<div>Hello!</div>')->at('div')->text;
+
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
@@ -10,21 +10,21 @@ use lib join '/', File::Spec->splitdir(dirname(__FILE__)), 'lib';
use lib join '/', File::Spec->splitdir(dirname(__FILE__)), '..', 'lib';
# Check if Mojo is installed
-eval 'use Mojo::Commands';
+eval 'use Mojolicious::Commands';
die <<EOF if $@;
-It looks like you don't have the Mojo Framework installed.
+It looks like you don't have the Mojolicious Framework installed.
Please visit http://mojolicious.org for detailed installation instructions.
EOF
# Start the command system
-Mojo::Commands->start;
+Mojolicious::Commands->start;
__END__
=head1 NAME
-mojo - The Mojo Command System
+mojo - The Mojolicious Command System
=head1 SEE ALSO
@@ -1,33 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use File::Basename 'dirname';
-use File::Spec;
-
-use lib join '/', File::Spec->splitdir(dirname(__FILE__)), 'lib';
-use lib join '/', File::Spec->splitdir(dirname(__FILE__)), '..', 'lib';
-
-# Check if Mojo is installed
-eval 'use Mojolicious::Commands';
-die <<EOF if $@;
-It looks like you don't have the Mojo Framework installed.
-Please visit http://mojolicious.org for detailed installation instructions.
-
-EOF
-
-# Start the command system
-Mojolicious::Commands->start;
-
-__END__
-
-=head1 NAME
-
-mojolicious - The Mojolicious Command System
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
-
-=cut
@@ -10,24 +10,25 @@ use Test::More;
use File::Spec;
use File::Temp;
+use FindBin;
+use IO::Socket::INET;
use Mojo::Client;
+use Mojo::IOLoop;
use Mojo::Template;
-use Test::Mojo::Server;
# Mac OS X only test
plan skip_all => 'Mac OS X required for this test!' unless $^O eq 'darwin';
plan skip_all => 'set TEST_APACHE to enable this test (developer only!)'
unless $ENV{TEST_APACHE};
-plan tests => 7;
+plan tests => 8;
# I'm not a robot!
# I don't like having discs crammed into me, unless they're Oreos.
# And then, only in the mouth.
-use_ok('Mojo::Server::CGI');
+use_ok 'Mojo::Server::CGI';
# Apache setup
-my $server = Test::Mojo::Server->new;
-my $port = $server->generate_port_ok;
+my $port = Mojo::IOLoop->generate_port;
my $dir = File::Temp::tempdir(CLEANUP => 1);
my $config = File::Spec->catfile($dir, 'cgi.config');
my $mt = Mojo::Template->new;
@@ -52,10 +53,9 @@ DocumentRoot <%= $dir %>
ScriptAlias /cgi-bin <%= $dir %>
EOF
-$server->command(['/usr/sbin/httpd', '-X', '-f', $config]);
# CGI setup
-my $lib = $server->home->lib_dir;
+my $lib = "$FindBin::Bin/../../lib";
my $cgi = File::Spec->catfile($dir, 'test.cgi');
$mt->render_to_file(<<'EOF', $cgi, $lib);
#!/usr/bin/env perl
@@ -72,20 +72,65 @@ Mojo::Server::CGI->new->run;
1;
EOF
chmod 0777, $cgi;
-ok(-x $cgi, 'script is executable');
+ok -x $cgi, 'script is executable';
# Start
-$server->start_server_ok;
+my $pid = open my $server, '-|', '/usr/sbin/httpd', '-X', '-f', $config;
+sleep 1
+ while !IO::Socket::INET->new(
+ Proto => 'tcp',
+ PeerAddr => 'localhost',
+ PeerPort => $port
+ );
# Request
my $client = Mojo::Client->new;
+my ($code, $body);
$client->get(
"http://127.0.0.1:$port/cgi-bin/test.cgi" => sub {
my $self = shift;
- is($self->res->code, 200, 'right status');
- like($self->res->body, qr/Mojo/, 'right content');
+ $code = $self->res->code;
+ $body = $self->res->body;
}
-)->process;
+)->start;
+is $code, 200, 'right status';
+like $body, qr/Mojo/, 'right content';
+
+# Form with chunked response
+my $params = {};
+for my $i (1 .. 10) { $params->{"test$i"} = $i }
+my $result = '';
+for my $key (sort keys %$params) { $result .= $params->{$key} }
+($code, $body) = undef;
+$client->post_form(
+ "http://127.0.0.1:$port/cgi-bin/test.cgi/diag/chunked_params" =>
+ $params => sub {
+ my $self = shift;
+ $code = $self->res->code;
+ $body = $self->res->body;
+ }
+)->start;
+is $code, 200, 'right status';
+is $body, $result, 'right content';
+
+# Upload
+($code, $body) = undef;
+$client->post_form(
+ "http://127.0.0.1:$port/cgi-bin/test.cgi/diag/upload" =>
+ {file => {content => $result}} => sub {
+ my $self = shift;
+ $code = $self->res->code;
+ $body = $self->res->body;
+ }
+)->start;
+is $code, 200, 'right status';
+is $body, $result, 'right content';
# Stop
-$server->stop_server_ok;
+kill 'INT', $pid;
+sleep 1
+ while IO::Socket::INET->new(
+ Proto => 'tcp',
+ PeerAddr => 'localhost',
+ PeerPort => $port
+ );
@@ -10,22 +10,22 @@ use Test::More;
use File::Spec;
use File::Temp;
+use IO::Socket::INET;
use Mojo::Client;
+use Mojo::IOLoop;
use Mojo::Template;
-use Test::Mojo::Server;
# Mac OS X only test
plan skip_all => 'Mac OS X required for this test!' unless $^O eq 'darwin';
plan skip_all => 'set TEST_APACHE to enable this test (developer only!)'
unless $ENV{TEST_APACHE};
-plan tests => 7;
+plan tests => 8;
# Robots don't have any emotions, and sometimes that makes me very sad.
-use_ok('Mojo::Server::FastCGI');
+use_ok 'Mojo::Server::FastCGI';
# Setup
-my $server = Test::Mojo::Server->new;
-my $port = $server->generate_port_ok;
+my $port = Mojo::IOLoop->generate_port;
my $dir = File::Temp::tempdir(CLEANUP => 1);
my $config = File::Spec->catfile($dir, 'fcgi.config');
my $mt = Mojo::Template->new;
@@ -48,7 +48,7 @@ Mojo::Server::FastCGI->new->run;
1;
EOF
chmod 0777, $fcgi;
-ok(-x $fcgi, 'script is executable');
+ok -x $fcgi, 'script is executable';
# Apache setup
$mt->render_to_file(<<'EOF', $config, $dir, $port, $fcgi);
@@ -75,18 +75,61 @@ Alias / <%= $fcgi %>/
EOF
# Start
-$server->command(['/usr/sbin/httpd', '-X', '-f', $config]);
-$server->start_server_ok;
+my $pid = open my $server, '-|', '/usr/sbin/httpd', '-X', '-f', $config;
+sleep 1
+ while !IO::Socket::INET->new(
+ Proto => 'tcp',
+ PeerAddr => 'localhost',
+ PeerPort => $port
+ );
# Request
my $client = Mojo::Client->new;
+my ($code, $body);
$client->get(
"http://127.0.0.1:$port/" => sub {
my $self = shift;
- is($self->res->code, 200, 'right status');
- like($self->res->body, qr/Mojo/, 'right content');
+ $code = $self->res->code;
+ $body = $self->res->body;
}
-)->process;
+)->start;
+is $code, 200, 'right status';
+like $body, qr/Mojo/, 'right content';
+
+# Form with chunked response
+my $params = {};
+for my $i (1 .. 10) { $params->{"test$i"} = $i }
+my $result = '';
+for my $key (sort keys %$params) { $result .= $params->{$key} }
+($code, $body) = undef;
+$client->post_form(
+ "http://127.0.0.1:$port/diag/chunked_params" => $params => sub {
+ my $self = shift;
+ $code = $self->res->code;
+ $body = $self->res->body;
+ }
+)->start;
+is $code, 200, 'right status';
+is $body, $result, 'right content';
+
+# Upload
+($code, $body) = undef;
+$client->post_form(
+ "http://127.0.0.1:$port/diag/upload" => {file => {content => $result}} =>
+ sub {
+ my $self = shift;
+ $code = $self->res->code;
+ $body = $self->res->body;
+ }
+)->start;
+is $code, 200, 'right status';
+is $body, $result, 'right content';
# Stop
-$server->stop_server_ok;
+kill 'INT', $pid;
+sleep 1
+ while IO::Socket::INET->new(
+ Proto => 'tcp',
+ PeerAddr => 'localhost',
+ PeerPort => $port
+ );
@@ -6,27 +6,21 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 39;
+use Test::More tests => 43;
# I was so bored I cut the pony tail off the guy in front of us.
# Look at me, I'm a grad student. I'm 30 years old and I made $600 last year.
# Bart, don't make fun of grad students.
# They've just made a terrible life choice.
-use_ok('Mojo');
-use_ok('Mojo::Client');
-use_ok('Mojo::Transaction::HTTP');
-use_ok('Mojo::HelloWorld');
+use_ok 'Mojo';
+use_ok 'Mojo::Client';
+use_ok 'Mojo::Transaction::HTTP';
+use_ok 'Mojo::HelloWorld';
# Logger
my $logger = Mojo::Log->new;
my $app = Mojo->new({log => $logger});
-is($app->log, $logger, 'right logger');
+is $app->log, $logger, 'right logger';
$app = Mojo::HelloWorld->new;
my $client = Mojo::Client->new->app($app);
@@ -37,14 +31,14 @@ my $buffer = '';
$client->ioloop->connect(
address => 'localhost',
port => $port,
- connect_cb => sub {
+ on_connect => sub {
my ($self, $id, $chunk) = @_;
$self->write($id,
"GET /1/ HTTP/1.1\x0d\x0a"
. "Expect: 100-continue\x0d\x0a"
. "Content-Length: 4\x0d\x0a\x0d\x0a");
},
- read_cb => sub {
+ on_read => sub {
my ($self, $id, $chunk) = @_;
$buffer .= $chunk;
$self->drop($id) and $self->stop if $buffer =~ /Mojo is working!/;
@@ -53,14 +47,14 @@ $client->ioloop->connect(
}
);
$client->ioloop->start;
-like($buffer, qr/HTTP\/1.1 100 Continue/, 'request was continued');
+like $buffer, qr/HTTP\/1.1 100 Continue/, 'request was continued';
# Pipelined
$buffer = '';
$client->ioloop->connect(
address => 'localhost',
port => $port,
- connect_cb => sub {
+ on_connect => sub {
my ($self, $id) = @_;
$self->write($id,
"GET /2/ HTTP/1.1\x0d\x0a"
@@ -68,57 +62,57 @@ $client->ioloop->connect(
. "GET /3/ HTTP/1.1\x0d\x0a"
. "Content-Length: 0\x0d\x0a\x0d\x0a");
},
- read_cb => sub {
+ on_read => sub {
my ($self, $id, $chunk) = @_;
$buffer .= $chunk;
$self->drop($id) and $self->stop if $buffer =~ /Mojo.*Mojo/gs;
}
);
$client->ioloop->start;
-like($buffer, qr/Mojo/, 'transactions were pipelined');
+like $buffer, qr/Mojo/, 'transactions were pipelined';
# Normal request
my $tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('/5/');
-$client->process($tx);
-ok($tx->keep_alive, 'will be kept alive');
-is($tx->res->code, 200, 'right status');
-like($tx->res->body, qr/Mojo/, 'right content');
+$client->start($tx);
+ok $tx->keep_alive, 'will be kept alive';
+is $tx->res->code, 200, 'right status';
+like $tx->res->body, qr/Mojo/, 'right content';
# Keep alive request
$tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('/6/');
-$client->process($tx);
-ok($tx->keep_alive, 'will be kept alive');
-ok($tx->kept_alive, 'was kept alive');
-is($tx->res->code, 200, 'right status');
-like($tx->res->body, qr/Mojo/, 'right content');
+$client->start($tx);
+ok $tx->keep_alive, 'will be kept alive';
+ok $tx->kept_alive, 'was kept alive';
+is $tx->res->code, 200, 'right status';
+like $tx->res->body, qr/Mojo/, 'right content';
# Non keep alive request
$tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('/7/');
$tx->req->headers->connection('close');
-$client->process($tx);
-ok(!$tx->keep_alive, 'will not be kept alive');
-ok($tx->kept_alive, 'was kept alive');
-is($tx->res->code, 200, 'right status');
-is($tx->res->headers->connection, 'Close', 'right "Connection" value');
-like($tx->res->body, qr/Mojo/, 'right content');
+$client->start($tx);
+ok !$tx->keep_alive, 'will not be kept alive';
+ok $tx->kept_alive, 'was kept alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->headers->connection, 'Close', 'right "Connection" value';
+like $tx->res->body, qr/Mojo/, 'right content';
# Second non keep alive request
$tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('/8/');
$tx->req->headers->connection('close');
-$client->process($tx);
-ok(!$tx->keep_alive, 'will not be kept alive');
-ok(!$tx->kept_alive, 'was not kept alive');
-is($tx->res->code, 200, 'right status');
-is($tx->res->headers->connection, 'Close', 'right "Connection" value');
-like($tx->res->body, qr/Mojo/, 'right content');
+$client->start($tx);
+ok !$tx->keep_alive, 'will not be kept alive';
+ok !$tx->kept_alive, 'was not kept alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->headers->connection, 'Close', 'right "Connection" value';
+like $tx->res->body, qr/Mojo/, 'right content';
# POST request
$tx = Mojo::Transaction::HTTP->new;
@@ -126,9 +120,9 @@ $tx->req->method('POST');
$tx->req->url->parse('/9/');
$tx->req->headers->expect('fun');
$tx->req->body('foo bar baz' x 128);
-$client->process($tx);
-is($tx->res->code, 200, 'right status');
-like($tx->res->body, qr/Mojo/, 'right content');
+$client->start($tx);
+is $tx->res->code, 200, 'right status';
+like $tx->res->body, qr/Mojo/, 'right content';
# POST request
$tx = Mojo::Transaction::HTTP->new;
@@ -136,10 +130,10 @@ $tx->req->method('POST');
$tx->req->url->parse('/10/');
$tx->req->headers->expect('fun');
$tx->req->body('bar baz foo' x 128);
-$client->process($tx);
-ok(defined $tx->connection, 'has connection id');
-is($tx->res->code, 200, 'right status');
-like($tx->res->body, qr/Mojo/, 'right content');
+$client->start($tx);
+ok defined $tx->connection, 'has connection id';
+is $tx->res->code, 200, 'right status';
+like $tx->res->body, qr/Mojo/, 'right content';
# Multiple requests
$tx = Mojo::Transaction::HTTP->new;
@@ -148,11 +142,11 @@ $tx->req->url->parse('/11/');
my $tx2 = Mojo::Transaction::HTTP->new;
$tx2->req->method('GET');
$tx2->req->url->parse('/12/');
-$client->process($tx, $tx2);
-ok(defined $tx->connection, 'has connection id');
-ok(defined $tx2->connection, 'has connection id');
-ok($tx->is_done, 'transaction is done');
-ok($tx2->is_done, 'transaction is done');
+$client->start($tx, $tx2);
+ok defined $tx->connection, 'has connection id';
+ok defined $tx2->connection, 'has connection id';
+ok $tx->is_done, 'transaction is done';
+ok $tx2->is_done, 'transaction is done';
# Multiple requests
$tx = Mojo::Transaction::HTTP->new;
@@ -166,10 +160,39 @@ $tx2->req->body('bar baz foo' x 128);
my $tx3 = Mojo::Transaction::HTTP->new;
$tx3->req->method('GET');
$tx3->req->url->parse('/15/');
-$client->process($tx, $tx2, $tx3);
-ok($tx->is_done, 'transaction is done');
-ok(!$tx->error, 'has no errors');
-ok($tx2->is_done, 'transaction is done');
-ok(!$tx2->error, 'has no error');
-ok($tx3->is_done, 'transaction is done');
-ok(!$tx3->error, 'has no error');
+$client->start($tx, $tx2, $tx3);
+ok $tx->is_done, 'transaction is done';
+ok !$tx->error, 'has no errors';
+ok $tx2->is_done, 'transaction is done';
+ok !$tx2->error, 'has no error';
+ok $tx3->is_done, 'transaction is done';
+ok !$tx3->error, 'has no error';
+
+# Form with chunked response
+my $params = {};
+for my $i (1 .. 10) { $params->{"test$i"} = $i }
+my $result = '';
+for my $key (sort keys %$params) { $result .= $params->{$key} }
+my ($code, $body);
+$client->post_form(
+ "http://127.0.0.1:$port/diag/chunked_params" => $params => sub {
+ my $self = shift;
+ $code = $self->res->code;
+ $body = $self->res->body;
+ }
+)->start;
+is $code, 200, 'right status';
+is $body, $result, 'right content';
+
+# Upload
+($code, $body) = undef;
+$client->post_form(
+ "http://127.0.0.1:$port/diag/upload" => {file => {content => $result}} =>
+ sub {
+ my $self = shift;
+ $code = $self->res->code;
+ $body = $self->res->body;
+ }
+)->start;
+is $code, 200, 'right status';
+is $body, $result, 'right content';
@@ -9,71 +9,71 @@ use Test::More tests => 42;
# And for every dollar of Krusty merchandise you buy,
# I will be nice to a sick kid.
# For legal purposes, sick kids may include hookers with a cold.
-use_ok('Mojo::Asset::File');
-use_ok('Mojo::Asset::Memory');
+use_ok 'Mojo::Asset::File';
+use_ok 'Mojo::Asset::Memory';
# File asset
my $file = Mojo::Asset::File->new;
$file->add_chunk('abc');
-is($file->contains(''), 0, 'empty string at position 0');
-is($file->contains('abc'), 0, '"abc" at position 0');
-is($file->contains('bc'), 1, '"bc" at position 1');
-is($file->contains('db'), -1, 'does not contain "db"');
+is $file->contains(''), 0, 'empty string at position 0';
+is $file->contains('abc'), 0, '"abc" at position 0';
+is $file->contains('bc'), 1, '"bc" at position 1';
+is $file->contains('db'), -1, 'does not contain "db"';
# Memory asset
my $mem = Mojo::Asset::Memory->new;
$mem->add_chunk('abc');
-is($mem->contains(''), 0, 'empty string at position 0');
-is($mem->contains('abc'), 0, '"abc" at position 0');
-is($mem->contains('bc'), 1, '"bc" at position 1');
-is($mem->contains('db'), -1, 'does not contain "db"');
+is $mem->contains(''), 0, 'empty string at position 0';
+is $mem->contains('abc'), 0, '"abc" at position 0';
+is $mem->contains('bc'), 1, '"bc" at position 1';
+is $mem->contains('db'), -1, 'does not contain "db"';
# Empty file asset
$file = Mojo::Asset::File->new;
-is($file->contains(''), 0, 'empty string at position 0');
+is $file->contains(''), 0, 'empty string at position 0';
# Empty memory asset
$mem = Mojo::Asset::File->new;
-is($mem->contains(''), 0, 'empty string at position 0');
+is $mem->contains(''), 0, 'empty string at position 0';
# File asset range support (a[bcdef])
$file = Mojo::Asset::File->new(start_range => 1);
$file->add_chunk('abcdef');
-is($file->contains(''), 0, 'empty string at position 0');
-is($file->contains('bcdef'), 0, '"bcdef" at position 0');
-is($file->contains('cdef'), 1, '"cdef" at position 1');
-is($file->contains('db'), -1, 'does not contain "db"');
+is $file->contains(''), 0, 'empty string at position 0';
+is $file->contains('bcdef'), 0, '"bcdef" at position 0';
+is $file->contains('cdef'), 1, '"cdef" at position 1';
+is $file->contains('db'), -1, 'does not contain "db"';
# Memory asset range support (a[bcdef])
$mem = Mojo::Asset::Memory->new(start_range => 1);
$mem->add_chunk('abcdef');
-is($mem->contains(''), 0, 'empty string at position 0');
-is($mem->contains('bcdef'), 0, '"bcdef" at position 0');
-is($mem->contains('cdef'), 1, '"cdef" at position 1');
-is($mem->contains('db'), -1, 'does not contain "db"');
+is $mem->contains(''), 0, 'empty string at position 0';
+is $mem->contains('bcdef'), 0, '"bcdef" at position 0';
+is $mem->contains('cdef'), 1, '"cdef" at position 1';
+is $mem->contains('db'), -1, 'does not contain "db"';
# File asset range support (ab[cdefghi]jk)
my $backup = $ENV{MOJO_CHUNK_SIZE} || '';
$ENV{MOJO_CHUNK_SIZE} = 1024;
$file = Mojo::Asset::File->new(start_range => 2, end_range => 8);
$file->add_chunk('abcdefghijk');
-is($file->contains(''), 0, 'empty string at position 0');
-is($file->contains('cdefghi'), 0, '"cdefghi" at position 0');
-is($file->contains('fghi'), 3, '"fghi" at position 3');
-is($file->contains('f'), 3, '"f" at position 3');
-is($file->contains('hi'), 5, '"hi" at position 5');
-is($file->contains('db'), -1, 'does not contain "db"');
+is $file->contains(''), 0, 'empty string at position 0';
+is $file->contains('cdefghi'), 0, '"cdefghi" at position 0';
+is $file->contains('fghi'), 3, '"fghi" at position 3';
+is $file->contains('f'), 3, '"f" at position 3';
+is $file->contains('hi'), 5, '"hi" at position 5';
+is $file->contains('db'), -1, 'does not contain "db"';
my $chunk = $file->get_chunk(0);
-is($chunk, 'cdefghi', 'chunk from position 0');
+is $chunk, 'cdefghi', 'chunk from position 0';
$chunk = $file->get_chunk(1);
-is($chunk, 'defghi', 'chunk from position 1');
+is $chunk, 'defghi', 'chunk from position 1';
$chunk = $file->get_chunk(5);
-is($chunk, 'hi', 'chunk from position 5');
+is $chunk, 'hi', 'chunk from position 5';
$ENV{MOJO_CHUNK_SIZE} = 1;
$chunk = $file->get_chunk(0);
-is($chunk, 'c', 'chunk from position 0 with size 1');
+is $chunk, 'c', 'chunk from position 0 with size 1';
$chunk = $file->get_chunk(5);
-is($chunk, 'h', 'chunk from position 5 with size 1');
+is $chunk, 'h', 'chunk from position 5 with size 1';
$ENV{MOJO_CHUNK_SIZE} = $backup;
# Memory asset range support (ab[cdefghi]jk)
@@ -81,21 +81,21 @@ $backup = $ENV{MOJO_CHUNK_SIZE} || '';
$ENV{MOJO_CHUNK_SIZE} = 1024;
$mem = Mojo::Asset::Memory->new(start_range => 2, end_range => 8);
$mem->add_chunk('abcdefghijk');
-is($mem->contains(''), 0, 'empty string at position 0');
-is($mem->contains('cdefghi'), 0, '"cdefghi" at position 0');
-is($mem->contains('fghi'), 3, '"fghi" at position 3');
-is($mem->contains('f'), 3, '"f" at position 3');
-is($mem->contains('hi'), 5, '"hi" at position 5');
-is($mem->contains('db'), -1, 'does not contain "db"');
+is $mem->contains(''), 0, 'empty string at position 0';
+is $mem->contains('cdefghi'), 0, '"cdefghi" at position 0';
+is $mem->contains('fghi'), 3, '"fghi" at position 3';
+is $mem->contains('f'), 3, '"f" at position 3';
+is $mem->contains('hi'), 5, '"hi" at position 5';
+is $mem->contains('db'), -1, 'does not contain "db"';
$chunk = $mem->get_chunk(0);
-is($chunk, 'cdefghi', 'chunk from position 0');
+is $chunk, 'cdefghi', 'chunk from position 0';
$chunk = $mem->get_chunk(1);
-is($chunk, 'defghi', 'chunk from position 1');
+is $chunk, 'defghi', 'chunk from position 1';
$chunk = $mem->get_chunk(5);
-is($chunk, 'hi', 'chunk from position 5');
+is $chunk, 'hi', 'chunk from position 5';
$ENV{MOJO_CHUNK_SIZE} = 1;
$chunk = $mem->get_chunk(0);
-is($chunk, 'c', 'chunk from position 0 with size 1');
+is $chunk, 'c', 'chunk from position 0 with size 1';
$chunk = $mem->get_chunk(5);
-is($chunk, 'h', 'chunk from position 5 with size 1');
+is $chunk, 'h', 'chunk from position 5 with size 1';
$ENV{MOJO_CHUNK_SIZE} = $backup;
@@ -25,34 +25,34 @@ use Test::More tests => 404;
# I've done everything the Bible says,
# even the stuff that contradicts the other stuff!
-use_ok('Mojo::Base');
+use_ok 'Mojo::Base';
# Basic functionality
my $monkeys = [];
for my $i (1 .. 50) {
$monkeys->[$i] = BaseTest->new;
$monkeys->[$i]->bananas($i);
- is($monkeys->[$i]->bananas, $i, 'right attribute value');
+ is $monkeys->[$i]->bananas, $i, 'right attribute value';
}
for my $i (51 .. 100) {
$monkeys->[$i] = BaseTest->new(bananas => $i);
- is($monkeys->[$i]->bananas, $i, 'right attribute value');
+ is $monkeys->[$i]->bananas, $i, 'right attribute value';
}
# "default" defined but false
my $m = $monkeys->[1];
-ok(defined($m->figs));
-is($m->figs, 0, 'right attribute value');
+ok defined($m->figs);
+is $m->figs, 0, 'right attribute value';
$m->figs(5);
-is($m->figs, 5, 'right attribute value');
+is $m->figs, 5, 'right attribute value';
# "default" support
my $y = 1;
for my $i (101 .. 150) {
$y = !$y;
$monkeys->[$i] = BaseTest->new;
- is(ref $monkeys->[$i]->name('foobarbaz'),
- 'BaseTest', 'attribute value has right class');
+ is ref $monkeys->[$i]->name('foobarbaz'),
+ 'BaseTest', 'attribute value has right class';
$monkeys->[$i]->heads('3') if $y;
$y
? is($monkeys->[$i]->heads, 3, 'right attribute value')
@@ -62,10 +62,10 @@ for my $i (101 .. 150) {
# "chained" and coderef "default" support
for my $i (151 .. 200) {
$monkeys->[$i] = BaseTest->new;
- is($monkeys->[$i]->ears, 2, 'right attribute value');
- is($monkeys->[$i]->ears(6)->ears, 6, 'right chained attribute value');
- is($monkeys->[$i]->eyes, 2, 'right attribute value');
- is($monkeys->[$i]->eyes(6)->eyes, 6, 'right chained attribute value');
+ is $monkeys->[$i]->ears, 2, 'right attribute value';
+ is $monkeys->[$i]->ears(6)->ears, 6, 'right chained attribute value';
+ is $monkeys->[$i]->eyes, 2, 'right attribute value';
+ is $monkeys->[$i]->eyes(6)->eyes, 6, 'right chained attribute value';
}
1;
@@ -12,302 +12,266 @@ use Test::More;
plan skip_all => 'Perl 5.10 required for this test!'
unless eval { require Digest::SHA; 1 };
-plan tests => 78;
+plan tests => 81;
-use_ok('Mojo::ByteStream', 'b');
+use_ok 'Mojo::ByteStream', 'b';
# Empty
my $stream = Mojo::ByteStream->new;
-is($stream->size, 0, 'size is 0');
-is($stream->raw_size, 0, 'raw size is 0');
+is $stream->size, 0, 'size is 0';
+is $stream->raw_size, 0, 'raw size is 0';
# Chunk
$stream->add_chunk("line1\nline2");
-is($stream->size, 11, 'size is 11');
-is($stream->raw_size, 11, 'raw size is 11');
+is $stream->size, 11, 'size is 11';
+is $stream->raw_size, 11, 'raw size is 11';
# Clean
my $buffer = $stream->empty;
-is($stream->size, 0, 'size is 0');
-is($stream->raw_size, 11, 'raw size is 11');
-is($buffer, "line1\nline2", 'right buffer content');
+is $stream->size, 0, 'size is 0';
+is $stream->raw_size, 11, 'raw size is 11';
+is $buffer, "line1\nline2", 'right buffer content';
# Add
$stream->add_chunk("first\nsec");
-is($stream->size, 9, 'size is 9');
-is($stream->raw_size, 20, 'raw size is 20');
+is $stream->size, 9, 'size is 9';
+is $stream->raw_size, 20, 'raw size is 20';
# Remove
$buffer = $stream->remove(2);
-is($buffer, 'fi', 'removed chunk is "fi"');
-is($stream->size, 7, 'size is 7');
-is($stream->raw_size, 20, 'raw size is 20');
+is $buffer, 'fi', 'removed chunk is "fi"';
+is $stream->size, 7, 'size is 7';
+is $stream->raw_size, 20, 'raw size is 20';
# Get
-is($stream->get_line, 'rst', 'line is "rst"');
-is($stream->get_line, undef, 'no more lines');
+is $stream->get_line, 'rst', 'line is "rst"';
+is $stream->get_line, undef, 'no more lines';
# Stringify
$stream = Mojo::ByteStream->new->add_chunk('abc');
-is("$stream", 'abc', 'right buffer content');
-is($stream->to_string, 'abc', 'right buffer content');
+is "$stream", 'abc', 'right buffer content';
+is $stream->to_string, 'abc', 'right buffer content';
# camelize
$stream = b('foo_bar_baz');
-is($stream->camelize, 'FooBarBaz', 'right camelized result');
+is $stream->camelize, 'FooBarBaz', 'right camelized result';
$stream = b('FooBarBaz');
-is($stream->camelize, 'Foobarbaz', 'right camelized result');
+is $stream->camelize, 'Foobarbaz', 'right camelized result';
$stream = b('foo_b_b');
-is($stream->camelize, 'FooBB', 'right camelized result');
+is $stream->camelize, 'FooBB', 'right camelized result';
$stream = b('foo-b_b');
-is($stream->camelize, 'Foo::BB', 'right camelized result');
+is $stream->camelize, 'Foo::BB', 'right camelized result';
# decamelize
$stream = b('FooBarBaz');
-is($stream->decamelize, 'foo_bar_baz', 'right decamelized result');
+is $stream->decamelize, 'foo_bar_baz', 'right decamelized result';
$stream = b('foo_bar_baz');
-is($stream->decamelize, 'foo_bar_baz', 'right decamelized result');
+is $stream->decamelize, 'foo_bar_baz', 'right decamelized result';
$stream = b('FooBB');
-is($stream->decamelize, 'foo_b_b', 'right decamelized result');
+is $stream->decamelize, 'foo_b_b', 'right decamelized result';
$stream = b('Foo::BB');
-is($stream->decamelize, 'foo-b_b', 'right decamelized result');
+is $stream->decamelize, 'foo-b_b', 'right decamelized result';
# b64_encode
$stream = b('foobar$%^&3217');
-is($stream->b64_encode, "Zm9vYmFyJCVeJjMyMTc=\n",
- 'right base64 encoded result');
+is $stream->b64_encode, "Zm9vYmFyJCVeJjMyMTc=\n",
+ 'right base64 encoded result';
# b64_decode
$stream = b("Zm9vYmFyJCVeJjMyMTc=\n");
-is($stream->b64_decode, 'foobar$%^&3217', 'right base64 decoded result');
+is $stream->b64_decode, 'foobar$%^&3217', 'right base64 decoded result';
# utf8 b64_encode
$stream = b("foo\x{df}\x{0100}bar%23\x{263a}")->b64_encode;
-is("$stream", "Zm9vw5/EgGJhciUyM+KYug==\n", 'right base64 encoded result');
+is "$stream", "Zm9vw5/EgGJhciUyM+KYug==\n", 'right base64 encoded result';
# utf8 b64_decode
$stream = b("Zm9vw5/EgGJhciUyM+KYug==\n")->b64_decode->decode('UTF-8');
-is( "$stream",
- "foo\x{df}\x{0100}bar%23\x{263a}",
- 'right base64 decoded result'
-);
+is "$stream", "foo\x{df}\x{0100}bar%23\x{263a}",
+ 'right base64 decoded result';
# b64_encode (custom line ending)
$stream = b('foobar$%^&3217');
-is($stream->b64_encode(''),
- "Zm9vYmFyJCVeJjMyMTc=", 'right base64 encoded result');
+is $stream->b64_encode(''),
+ "Zm9vYmFyJCVeJjMyMTc=", 'right base64 encoded result';
# url_escape
$stream = b('business;23');
-is($stream->url_escape, 'business%3B23', 'right url escaped result');
+is $stream->url_escape, 'business%3B23', 'right url escaped result';
# url_unescape
$stream = b('business%3B23');
-is($stream->url_unescape, 'business;23', 'right url unescaped result');
+is $stream->url_unescape, 'business;23', 'right url unescaped result';
# utf8 url_escape
$stream = b("foo\x{df}\x{0100}bar\x{263a}")->url_escape;
-is("$stream", 'foo%C3%9F%C4%80bar%E2%98%BA', 'right url escaped result');
+is "$stream", 'foo%C3%9F%C4%80bar%E2%98%BA', 'right url escaped result';
# utf8 url_unescape
$stream = b('foo%C3%9F%C4%80bar%E2%98%BA')->url_unescape->decode('UTF-8');
-is("$stream", "foo\x{df}\x{0100}bar\x{263a}", 'right url unescaped result');
+is "$stream", "foo\x{df}\x{0100}bar\x{263a}", 'right url unescaped result';
# url_sanitize
$stream = b('t%c3est%6a1%7E23%30')->url_sanitize;
-is("$stream", 't%C3estj1~230', 'right url sanitized result');
+is "$stream", 't%C3estj1~230', 'right url sanitized result';
# qp_encode
$stream = b("foo\x{99}bar$%^&3217");
-like($stream->qp_encode, qr/^foo\=99bar0\^\&3217/, 'right qp encoded result');
+like $stream->qp_encode, qr/^foo\=99bar0\^\&3217/, 'right qp encoded result';
# qp_decode
$stream = b("foo=99bar0^&3217=\n");
-is($stream->qp_decode, "foo\x{99}bar$%^&3217", 'right qp decoded result');
+is $stream->qp_decode, "foo\x{99}bar$%^&3217", 'right qp decoded result';
# quote
$stream = b('foo; 23 "bar');
-is($stream->quote, '"foo; 23 \"bar"', 'right quoted result');
+is $stream->quote, '"foo; 23 \"bar"', 'right quoted result';
# unquote
$stream = b('"foo 23 \"bar"');
-is($stream->unquote, 'foo 23 "bar', 'right unquoted result');
+is $stream->unquote, 'foo 23 "bar', 'right unquoted result';
# md5_bytes
$stream = b('foo bar baz');
-is( unpack('H*', $stream->md5_bytes),
- "ab07acbb1e496801937adfa772424bf7",
- 'right binary md5 checksum'
-);
+is unpack('H*', $stream->md5_bytes), "ab07acbb1e496801937adfa772424bf7",
+ 'right binary md5 checksum';
# md5_sum
$stream = b('foo bar baz');
-is($stream->md5_sum, 'ab07acbb1e496801937adfa772424bf7',
- 'right md5 checksum');
+is $stream->md5_sum, 'ab07acbb1e496801937adfa772424bf7', 'right md5 checksum';
# sha1_bytes
$stream = b('foo bar baz');
-is( unpack('H*', $stream->sha1_bytes),
- "c7567e8b39e2428e38bf9c9226ac68de4c67dc39",
- 'right binary sha1 checksum'
-);
+is unpack('H*', $stream->sha1_bytes),
+ "c7567e8b39e2428e38bf9c9226ac68de4c67dc39", 'right binary sha1 checksum';
# sha1_sum
$stream = b('foo bar baz');
-is( $stream->sha1_sum,
- 'c7567e8b39e2428e38bf9c9226ac68de4c67dc39',
- 'right sha1 checksum'
-);
+is $stream->sha1_sum, 'c7567e8b39e2428e38bf9c9226ac68de4c67dc39',
+ 'right sha1 checksum';
# length
$stream = b('foo bar baz');
-is($stream->size, 11, 'size is 11');
+is $stream->size, 11, 'size is 11';
# "0"
$stream = b('0');
-is($stream->size, 1, 'size is 1');
-is($stream->to_string, '0', 'right buffer content');
+is $stream->size, 1, 'size is 1';
+is $stream->to_string, '0', 'right buffer content';
# hmac_md5_sum (RFC2202)
-is( b("Hi There")->hmac_md5_sum(chr(0x0b) x 16),
- '9294727a3638bb1c13f48ef8158bfc9d',
- 'right hmac md5 checksum'
-);
-is( b("what do ya want for nothing?")->hmac_md5_sum("Jefe"),
- '750c783e6ab0b503eaa86e310a5db738',
- 'right hmac md5 checksum'
-);
-is( b(chr(0xdd) x 50)->hmac_md5_sum(chr(0xaa) x 16),
- '56be34521d144c88dbb8c733f0e8b3f6',
- 'right hmac md5 checksum'
-);
-is( b(chr(0xcd) x 50)->hmac_md5_sum(
- pack 'H*' => '0102030405060708090a0b0c0d0e0f10111213141516171819'
- ),
- '697eaf0aca3a3aea3a75164746ffaa79',
- 'right hmac md5 checksum'
-);
-is( b("Test With Truncation")->hmac_md5_sum(chr(0x0c) x 16),
- '56461ef2342edc00f9bab995690efd4c',
- 'right hmac md5 checksum'
-);
-is( b("Test Using Larger Than Block-Size Key - Hash Key First")
- ->hmac_md5_sum(chr(0xaa) x 80),
- '6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd',
- 'right hmac md5 checksum'
-);
-is( b( "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
- )->hmac_md5_sum(chr(0xaa) x 80),
- '6f630fad67cda0ee1fb1f562db3aa53e',
- 'right hmac md5 checksum'
-);
+is b("Hi There")->hmac_md5_sum(chr(0x0b) x 16),
+ '9294727a3638bb1c13f48ef8158bfc9d', 'right hmac md5 checksum';
+is b("what do ya want for nothing?")->hmac_md5_sum("Jefe"),
+ '750c783e6ab0b503eaa86e310a5db738', 'right hmac md5 checksum';
+is b(chr(0xdd) x 50)->hmac_md5_sum(chr(0xaa) x 16),
+ '56be34521d144c88dbb8c733f0e8b3f6', 'right hmac md5 checksum';
+is b(chr(0xcd) x 50)
+ ->hmac_md5_sum(
+ pack 'H*' => '0102030405060708090a0b0c0d0e0f10111213141516171819'),
+ '697eaf0aca3a3aea3a75164746ffaa79', 'right hmac md5 checksum';
+is b("Test With Truncation")->hmac_md5_sum(chr(0x0c) x 16),
+ '56461ef2342edc00f9bab995690efd4c', 'right hmac md5 checksum';
+is b("Test Using Larger Than Block-Size Key - Hash Key First")
+ ->hmac_md5_sum(chr(0xaa) x 80), '6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd',
+ 'right hmac md5 checksum';
+is b(
+ "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
+ )->hmac_md5_sum(chr(0xaa) x 80), '6f630fad67cda0ee1fb1f562db3aa53e',
+ 'right hmac md5 checksum';
# hmac_sha1_sum (RFC2202)
-is( b("Hi There")->hmac_sha1_sum(chr(0x0b) x 20),
- 'b617318655057264e28bc0b6fb378c8ef146be00',
- 'right hmac sha1 checksum'
-);
-is( b("what do ya want for nothing?")->hmac_sha1_sum("Jefe"),
- 'effcdf6ae5eb2fa2d27416d5f184df9c259a7c79',
- 'right hmac sha1 checksum'
-);
-is( b(chr(0xdd) x 50)->hmac_sha1_sum(chr(0xaa) x 20),
- '125d7342b9ac11cd91a39af48aa17b4f63f175d3',
- 'right hmac sha1 checksum'
-);
-is( b(chr(0xcd) x 50)->hmac_sha1_sum(
- pack 'H*' => '0102030405060708090a0b0c0d0e0f10111213141516171819'
- ),
- '4c9007f4026250c6bc8414f9bf50c86c2d7235da',
- 'right hmac sha1 checksum'
-);
-is( b("Test With Truncation")->hmac_sha1_sum(chr(0x0c) x 20),
- '4c1a03424b55e07fe7f27be1d58bb9324a9a5a04',
- 'right hmac sha1 checksum'
-);
-is( b("Test Using Larger Than Block-Size Key - Hash Key First")
- ->hmac_sha1_sum(chr(0xaa) x 80),
- 'aa4ae5e15272d00e95705637ce8a3b55ed402112',
- 'right hmac sha1 checksum'
-);
-is( b( "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
- )->hmac_sha1_sum(chr(0xaa) x 80),
- 'e8e99d0f45237d786d6bbaa7965c7808bbff1a91',
- 'right hmac sha1 checksum'
-);
+is b("Hi There")->hmac_sha1_sum(chr(0x0b) x 20),
+ 'b617318655057264e28bc0b6fb378c8ef146be00', 'right hmac sha1 checksum';
+is b("what do ya want for nothing?")->hmac_sha1_sum("Jefe"),
+ 'effcdf6ae5eb2fa2d27416d5f184df9c259a7c79', 'right hmac sha1 checksum';
+is b(chr(0xdd) x 50)->hmac_sha1_sum(chr(0xaa) x 20),
+ '125d7342b9ac11cd91a39af48aa17b4f63f175d3', 'right hmac sha1 checksum';
+is b(chr(0xcd) x 50)
+ ->hmac_sha1_sum(
+ pack 'H*' => '0102030405060708090a0b0c0d0e0f10111213141516171819'),
+ '4c9007f4026250c6bc8414f9bf50c86c2d7235da', 'right hmac sha1 checksum';
+is b("Test With Truncation")->hmac_sha1_sum(chr(0x0c) x 20),
+ '4c1a03424b55e07fe7f27be1d58bb9324a9a5a04', 'right hmac sha1 checksum';
+is b("Test Using Larger Than Block-Size Key - Hash Key First")
+ ->hmac_sha1_sum(chr(0xaa) x 80), 'aa4ae5e15272d00e95705637ce8a3b55ed402112',
+ 'right hmac sha1 checksum';
+is b(
+ "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data"
+ )->hmac_sha1_sum(chr(0xaa) x 80),
+ 'e8e99d0f45237d786d6bbaa7965c7808bbff1a91', 'right hmac sha1 checksum';
# html_escape
-$stream = b('foobar<baz>');
-is($stream->html_escape, 'foobar<baz>', 'right html escaped result');
+$stream = b("foobar'<baz>");
+is $stream->html_escape, "foobar'<baz>",
+ 'right html escaped result';
# html_escape (nothing to escape)
$stream = b('foobar');
-is($stream->html_escape, 'foobar', 'right html escaped result');
+is $stream->html_escape, 'foobar', 'right html escaped result';
# html_unescape
$stream = b('foobar<baz>&"');
-is($stream->html_unescape, "foobar<baz>&\"", 'right html unescaped result');
+is $stream->html_unescape, "foobar<baz>&\"", 'right html unescaped result';
+
+# html_unescape (apos)
+$stream = b('foobar'<baz>&"');
+is $stream->html_unescape, "foobar'<baz>&\"", 'right html unescaped result';
# html_unescape (nothing to unescape)
$stream = b('foobar');
-is($stream->html_unescape, 'foobar', 'right html unescaped result');
+is $stream->html_unescape, 'foobar', 'right html unescaped result';
# utf8 html_escape
$stream = b("foobar<baz>&\"\x{152}")->html_escape;
-is( "$stream",
- 'foobar<baz>&"Œ',
- 'right html escaped result'
-);
+is "$stream", 'foobar<baz>&"Œ',
+ 'right html escaped result';
# utf8 html_unescape
$stream =
b('foobar<baz>&"Œ')->decode('UTF-8')->html_unescape;
-is("$stream", "foobar<baz>&\"\x{152}", 'right html unescaped result');
+is "$stream", "foobar<baz>&\"\x{152}", 'right html unescaped result';
# html_escape (path)
$stream =
b('/usr/local/lib/perl5/site_perl/5.10.0/Mojo/ByteStream.pm')->html_escape;
-is( "$stream",
- '/usr/local/lib/perl5/site_perl/5.10.0/Mojo/ByteStream.pm',
- 'right html escaped result'
-);
+is "$stream", '/usr/local/lib/perl5/site_perl/5.10.0/Mojo/ByteStream.pm',
+ 'right html escaped result';
# xml_escape
$stream = b(qq/la<f>\nbar"baz"'yada\n'<la/)->xml_escape;
-is( "$stream",
- "la<f>\nbar"baz"'yada\n'&lt;la",
- 'right xml escaped result'
-);
+is "$stream", "la<f>\nbar"baz"'yada\n'&lt;la",
+ 'right xml escaped result';
# utf8 xml_escape with nothing to escape
$stream = b('привет')->xml_escape;
-is("$stream", 'привет', 'right xml escaped result');
+is "$stream", 'привет', 'right xml escaped result';
# utf8 xml_escape
$stream = b('привет<foo>')->xml_escape;
-is("$stream", 'привет<foo>', 'right xml escaped result');
+is "$stream", 'привет<foo>', 'right xml escaped result';
# Decode invalid utf8
$stream = b("\x{1000}")->decode('UTF-8');
-is($stream->to_string, undef, 'decoding invalid utf8 worked');
+is $stream->to_string, undef, 'decoding invalid utf8 worked';
# punycode_encode
$stream = b('bücher')->punycode_encode;
-is("$stream", 'bcher-kva', 'right punycode encoded result');
+is "$stream", 'bcher-kva', 'right punycode encoded result';
# punycode_decode
$stream = b('bcher-kva')->punycode_decode;
-is("$stream", 'bücher', 'right punycode decoded result');
+is "$stream", 'bücher', 'right punycode decoded result';
# trim
$stream = b(' la la la ')->trim;
-is("$stream", 'la la la', 'right trimmed result');
+is "$stream", 'la la la', 'right trimmed result';
$stream = b(" \n la la la \n ")->trim;
-is("$stream", 'la la la', 'right trimmed result');
+is "$stream", 'la la la', 'right trimmed result';
$stream = b("\n la\nla la \n")->trim;
-is("$stream", "la\nla la", 'right trimmed result');
+is "$stream", "la\nla la", 'right trimmed result';
$stream = b(" \nla\nla\nla\n ")->trim;
-is("$stream", "la\nla\nla", 'right trimmed result');
+is "$stream", "la\nla\nla", 'right trimmed result';
# say and autojoin
$buffer = '';
@@ -317,4 +281,10 @@ my $backup = *STDOUT;
*STDOUT = $handle;
b(1, 2, 3)->say;
*STDOUT = $backup;
-is($buffer, "test\n123\n", 'right output');
+is $buffer, "test\n123\n", 'right output';
+
+# Nested bytestreams
+$stream = b(b('test'));
+ok !ref $stream->to_string, 'nested bytestream stringified';
+$stream = Mojo::ByteStream->new(Mojo::ByteStream->new('test'));
+ok !ref $stream->to_string, 'nested bytestream stringified';
@@ -6,15 +6,9 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
+use Test::More tests => 47;
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 805;
-
-use_ok('Mojo::Client');
+use_ok 'Mojo::Client';
# The strong must protect the sweet.
use Mojolicious::Lite;
@@ -27,11 +21,152 @@ get '/' => {text => 'works'};
my $client = Mojo::Client->singleton->app(app);
+# Server
+my $port = $client->ioloop->generate_port;
+my $buffer = {};
+my $last;
+my $id = $client->ioloop->listen(
+ port => $port,
+ on_accept => sub {
+ my ($loop, $id) = @_;
+ $last = $id;
+ $buffer->{$id} = '';
+ },
+ on_read => sub {
+ my ($loop, $id, $chunk) = @_;
+ $buffer->{$id} .= $chunk;
+ if (index $buffer->{$id}, "\x0d\x0a\x0d\x0a") {
+ delete $buffer->{$id};
+ $loop->write($id => "HTTP/1.1 200 OK\x0d\x0a"
+ . "Connection: keep-alive\x0d\x0a"
+ . "Content-Length: 6\x0d\x0a\x0d\x0aworks!");
+ }
+ },
+ on_error => sub {
+ my ($self, $id) = @_;
+ delete $buffer->{$id};
+ }
+);
+
+# Broken server (missing Content-Length header)
+my $port2 = $client->ioloop->generate_port;
+my $buffer2 = {};
+$client->ioloop->listen(
+ port => $port2,
+ on_accept => sub {
+ my ($loop, $id) = @_;
+ $buffer2->{$id} = '';
+ },
+ on_read => sub {
+ my ($loop, $id, $chunk) = @_;
+ $buffer2->{$id} .= $chunk;
+ if (index $buffer2->{$id}, "\x0d\x0a\x0d\x0a") {
+ delete $buffer2->{$id};
+ $loop->write(
+ $id => "HTTP/1.1 200 OK\x0d\x0a"
+ . "Connection: close\x0d\x0a\x0d\x0aworks too!",
+ sub { shift->drop(shift) }
+ );
+ }
+ },
+ on_error => sub {
+ my ($self, $id) = @_;
+ delete $buffer2->{$id};
+ }
+);
+
# GET /
my $tx = $client->get('/');
-ok($tx->success, 'successful');
-is($tx->res->code, 200, 'right status');
-is($tx->res->body, 'works', 'right content');
+ok $tx->success, 'successful';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works', 'right content';
+
+# GET / (missing Content-Lengt header)
+$tx = $client->get("http://localhost:$port2/");
+ok $tx->success, 'successful';
+is $tx->kept_alive, undef, 'kept connection not alive';
+is $tx->keep_alive, 0, 'keep connection not alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works too!', 'no content';
+
+# GET / (mock server)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, undef, 'kept connection not alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# GET / (mock server again)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, 1, 'kept connection alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# Close connection (bypassing safety net)
+$client->ioloop->_drop_immediately($last);
+
+# GET / (mock server closed connection)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, undef, 'kept connection not alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# GET / (mock server again)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, 1, 'kept connection alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# Close connection (bypassing safety net)
+$client->ioloop->_drop_immediately($last);
+
+# GET / (mock server closed connection)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, undef, 'kept connection not alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# GET / (mock server again)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, 1, 'kept connection alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# Taint connection (on UNIX)
+$^O eq 'MSWin32'
+ ? $client->ioloop->_drop_immediately($last)
+ : $client->ioloop->write($last => 'broken!');
+
+# GET / (mock server tainted connection)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, undef, 'kept connection not alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# GET / (mock server again)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, 1, 'kept connection alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
+
+# Taint connection (on UNIX)
+$^O eq 'MSWin32'
+ ? $client->ioloop->_drop_immediately($last)
+ : $client->ioloop->write($last => 'broken!');
+
+# GET / (mock server tainted connection)
+$tx = $client->get("http://localhost:$port/mock");
+ok $tx->success, 'successful';
+is $tx->kept_alive, undef, 'kept connection not alive';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works!', 'no content';
# Nested keep alive
my @kept_alive;
@@ -52,19 +187,34 @@ $client->async->get(
push @kept_alive, $tx->kept_alive;
$self->async->ioloop->stop;
}
- )->process;
+ )->start;
}
- )->process;
+ )->start;
}
-)->process;
+)->start;
$client->async->ioloop->start;
-is_deeply(\@kept_alive, [undef, 1, 1], 'connections kept alive');
-
-# Stress test to make sure we don't leak file descriptors
-for (1 .. 200) {
- my $tx = Mojo::Client->new->app(app)->get('/');
- is($tx->res->code, 200, 'right status');
- is($tx->res->body, 'works', 'right content');
- ok($tx->success, 'request successful');
- is($tx->kept_alive, undef, 'connection not kept alive');
-}
+is_deeply \@kept_alive, [undef, 1, 1], 'connections kept alive';
+
+# Simple nested keep alive with timers
+@kept_alive = ();
+my $async = $client->async;
+my $loop = $async->ioloop;
+$async->get(
+ '/',
+ sub {
+ push @kept_alive, pop->kept_alive;
+ $loop->timer(
+ '0.25' => sub {
+ $async->get(
+ '/',
+ sub {
+ push @kept_alive, pop->kept_alive;
+ $loop->timer('0.25' => sub { $loop->stop });
+ }
+ )->start;
+ }
+ );
+ }
+)->start;
+$loop->start;
+is_deeply \@kept_alive, [1, 1], 'connections kept alive';
@@ -10,14 +10,14 @@ use Test::More;
plan skip_all => 'set TEST_CLIENT to enable this test (developer only!)'
unless $ENV{TEST_CLIENT};
-plan tests => 99;
+plan tests => 102;
# So then I said to the cop, "No, you're driving under the influence...
# of being a jerk".
-use_ok('Mojo::Client');
-use_ok('Mojo::IOLoop');
-use_ok('Mojo::Transaction::HTTP');
-use_ok('ojo');
+use_ok 'Mojo::Client';
+use_ok 'Mojo::IOLoop';
+use_ok 'Mojo::Transaction::HTTP';
+use_ok 'ojo';
# Make sure clients dont taint the ioloop
my $loop = Mojo::IOLoop->new;
@@ -28,14 +28,14 @@ $client->get(
my $self = shift;
$code = $self->res->code;
}
-)->process;
+)->start;
$client = undef;
my $ticks = 0;
-$loop->tick_cb(sub { $ticks++ });
-$loop->idle_cb(sub { shift->stop });
+$loop->on_tick(sub { $ticks++ });
+$loop->on_idle(sub { shift->stop });
$loop->start;
-is($ticks, 1, 'loop not tainted');
-is($code, 301, 'right status');
+is $ticks, 1, 'loop not tainted';
+is $code, 301, 'right status';
# Fresh client
$client = Mojo::Client->new;
@@ -43,20 +43,25 @@ $client = Mojo::Client->new;
# Connection refused
$client->log->level('fatal');
my $tx = $client->build_tx(GET => 'http://localhost:99999');
-$client->process($tx);
-ok(!$tx->is_done, 'transaction is not done');
+$client->start($tx);
+ok !$tx->is_done, 'transaction is not done';
-# Fresh client again
-$client = Mojo::Client->new;
+# Connection refused
+$tx = $client->build_tx(GET => 'http://127.0.0.1:99999');
+$client->start($tx);
+ok !$tx->is_done, 'transaction is not done';
# Host does not exist
$tx = $client->build_tx(GET => 'http://cdeabcdeffoobarnonexisting.com');
-$client->process($tx);
-ok(!$tx->is_done, 'transaction is not done');
+$client->start($tx);
+ok !$tx->is_done, 'transaction is not done';
+
+# Fresh client again
+$client = Mojo::Client->new;
# Keep alive
my $async = $client->async;
-$async->get('http://mojolicio.us', sub { shift->ioloop->stop })->process;
+$async->get('http://mojolicio.us', sub { shift->ioloop->stop })->start;
$async->ioloop->start;
my $kept_alive = undef;
$async->get(
@@ -66,9 +71,22 @@ $async->get(
$self->ioloop->stop;
$kept_alive = shift->kept_alive;
}
-)->process;
+)->start;
$async->ioloop->start;
-is($kept_alive, 1, 'connection was kept alive');
+is $kept_alive, 1, 'connection was kept alive';
+
+# Resolve TXT record
+my $record;
+$async->ioloop->resolve(
+ 'google.com',
+ 'TXT',
+ sub {
+ my ($self, $records) = @_;
+ $record = $records->[0];
+ $self->stop;
+ }
+)->start;
+like $record, qr/spf/, 'right record';
# Nested keep alive
my @kept_alive;
@@ -89,23 +107,23 @@ $client->async->get(
push @kept_alive, $tx->kept_alive;
$self->ioloop->stop;
}
- )->process;
+ )->start;
}
- )->process;
+ )->start;
}
-)->process;
+)->start;
$client->ioloop->start;
-is_deeply(\@kept_alive, [1, 1, 1], 'connections kept alive');
+is_deeply \@kept_alive, [1, 1, 1], 'connections kept alive';
# Custom non keep alive request
$tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('http://cpan.org');
$tx->req->headers->connection('close');
-$client->process($tx);
-ok($tx->is_done, 'transaction is done');
-is($tx->res->code, 301, 'right status');
-like($tx->res->headers->connection, qr/close/i, 'right "Connection" header');
+$client->start($tx);
+ok $tx->is_done, 'transaction is done';
+is $tx->res->code, 301, 'right status';
+like $tx->res->headers->connection, qr/close/i, 'right "Connection" header';
# Proxy check
my $backup = $ENV{HTTP_PROXY} || '';
@@ -113,25 +131,26 @@ my $backup2 = $ENV{HTTPS_PROXY} || '';
$ENV{HTTP_PROXY} = 'http://127.0.0.1';
$ENV{HTTPS_PROXY} = 'https://127.0.0.1';
$client->detect_proxy;
-is($client->http_proxy, 'http://127.0.0.1', 'right proxy');
-is($client->https_proxy, 'https://127.0.0.1', 'right proxy');
+is $client->http_proxy, 'http://127.0.0.1', 'right proxy';
+is $client->https_proxy, 'https://127.0.0.1', 'right proxy';
$client->http_proxy(undef);
$client->https_proxy(undef);
-is($client->http_proxy, undef, 'right proxy');
-is($client->https_proxy, undef, 'right proxy');
+is $client->http_proxy, undef, 'right proxy';
+is $client->https_proxy, undef, 'right proxy';
$ENV{HTTP_PROXY} = $backup;
$ENV{HTTPS_PROXY} = $backup2;
# Oneliner
-is(g('mojolicious.org')->code, 200, 'right status');
-is(p('mojolicious.org/lalalala')->code, 404, 'right status');
-is(g('http://mojolicious.org')->code, 200, 'right status');
-is(p('http://mojolicious.org')->code, 404, 'right status');
-is(oO('http://mojolicious.org')->code, 200, 'right status');
-is(oO(POST => 'http://mojolicious.org')->code, 404, 'right status');
+is g('mojolicious.org')->code, 200, 'right status';
+is h('mojolicious.org')->code, 200, 'right status';
+is p('mojolicious.org/lalalala')->code, 404, 'right status';
+is g('http://mojolicious.org')->code, 200, 'right status';
+is p('http://mojolicious.org')->code, 404, 'right status';
+is oO('http://mojolicious.org')->code, 200, 'right status';
+is oO(POST => 'http://mojolicious.org')->code, 404, 'right status';
my $res = f('search.cpan.org/search' => {query => 'mojolicious'});
-like($res->body, qr/Mojolicious/, 'right content');
-is($res->code, 200, 'right status');
+like $res->body, qr/Mojolicious/, 'right content';
+is $res->code, 200, 'right status';
# Simple request
my ($method, $url);
@@ -143,32 +162,32 @@ $client->get(
$url = $self->req->url;
$code = $self->res->code;
}
-)->process;
-is($method, 'GET', 'right method');
-is($url, 'http://cpan.org', 'right url');
-is($code, 301, 'right status');
+)->start;
+is $method, 'GET', 'right method';
+is $url, 'http://cpan.org', 'right url';
+is $code, 301, 'right status';
# HTTPS request without TLS support
$tx = $client->get('https://www.google.com');
-ok(!!$tx->error, 'request failed');
+ok !!$tx->error, 'request failed';
# Simple request with body
$tx = $client->get('http://mojolicious.org' => 'Hi there!');
-is($tx->req->method, 'GET', 'right method');
-is($tx->req->url, 'http://mojolicious.org', 'right url');
-is($tx->req->headers->content_length, 9, 'right content length');
-is($tx->req->body, 'Hi there!', 'right content');
-is($tx->res->code, 200, 'right status');
+is $tx->req->method, 'GET', 'right method';
+is $tx->req->url, 'http://mojolicious.org', 'right url';
+is $tx->req->headers->content_length, 9, 'right content length';
+is $tx->req->body, 'Hi there!', 'right content';
+is $tx->res->code, 200, 'right status';
# Simple form post
$tx = $client->post_form(
'http://search.cpan.org/search' => {query => 'mojolicious'});
-is($tx->req->method, 'POST', 'right method');
-is($tx->req->url, 'http://search.cpan.org/search', 'right url');
-is($tx->req->headers->content_length, 17, 'right content length');
-is($tx->req->body, 'query=mojolicious', 'right content');
-like($tx->res->body, qr/Mojolicious/, 'right content');
-is($tx->res->code, 200, 'right status');
+is $tx->req->method, 'POST', 'right method';
+is $tx->req->url, 'http://search.cpan.org/search', 'right url';
+is $tx->req->headers->content_length, 17, 'right content length';
+is $tx->req->body, 'query=mojolicious', 'right content';
+like $tx->res->body, qr/Mojolicious/, 'right content';
+is $tx->res->code, 200, 'right status';
# Simple request
my $body;
@@ -181,11 +200,11 @@ $client->get(
$body = $self->req->body;
$code = $self->res->code;
}
-)->process;
-is($method, 'GET', 'right method');
-is($url, 'http://www.apache.org', 'right url');
-is($body, '', 'right content');
-is($code, 200, 'right status');
+)->start;
+is $method, 'GET', 'right method';
+is $url, 'http://www.apache.org', 'right url';
+is $body, '', 'right content';
+is $code, 200, 'right status';
# Simple parallel requests with keep alive
($method, $url, $code) = undef;
@@ -217,17 +236,17 @@ $client->get(
$code3 = $self->res->code;
}
);
-$client->process;
-is($method, 'GET', 'right method');
-is($url, 'http://google.com', 'right url');
-is($code, 301, 'right status');
-is($method2, 'GET', 'right method');
-is($url2, 'http://www.apache.org', 'right url');
-is($code2, 200, 'right status');
-is($kept_alive, 1, 'connection was kept alive');
-is($method3, 'GET', 'right method');
-is($url3, 'http://www.google.de', 'right url');
-is($code3, 200, 'right status');
+$client->start;
+is $method, 'GET', 'right method';
+is $url, 'http://google.com', 'right url';
+is $code, 301, 'right status';
+is $method2, 'GET', 'right method';
+is $url2, 'http://www.apache.org', 'right url';
+is $code2, 200, 'right status';
+is $kept_alive, 1, 'connection was kept alive';
+is $method3, 'GET', 'right method';
+is $url3, 'http://www.google.de', 'right url';
+is $code3, 200, 'right status';
# Simple requests with redirect
($method, $url, $code, $method2, $url2, $code2) = undef;
@@ -242,44 +261,37 @@ $client->get(
$url2 = $tx->previous->req->url;
$code2 = $tx->previous->res->code;
}
-)->process;
+)->start;
$client->max_redirects(0);
-is($method, 'GET', 'right method');
-is($url, 'http://www.google.de/', 'right url');
-is($code, 200, 'right status');
-is($method2, 'GET', 'right method');
-is($url2, 'http://www.google.com', 'right url');
-is($code2, 302, 'right status');
+is $method, 'GET', 'right method';
+is $url, 'http://www.google.de/', 'right url';
+is $code, 200, 'right status';
+is $method2, 'GET', 'right method';
+is $url2, 'http://www.google.com', 'right url';
+is $code2, 302, 'right status';
# Simple requests with redirect and no callback
$client->max_redirects(3);
$tx = $client->get('http://www.google.com');
$client->max_redirects(0);
-is($tx->req->method, 'GET', 'right method');
-is($tx->req->url, 'http://www.google.de/', 'right url');
-is($tx->res->code, 200, 'right status');
-is($tx->previous->req->method, 'GET', 'right method');
-is($tx->previous->req->url, 'http://www.google.com', 'right url');
-is($tx->previous->res->code, 302, 'right status');
+is $tx->req->method, 'GET', 'right method';
+is $tx->req->url, 'http://www.google.de/', 'right url';
+is $tx->res->code, 200, 'right status';
+is $tx->previous->req->method, 'GET', 'right method';
+is $tx->previous->req->url, 'http://www.google.com', 'right url';
+is $tx->previous->res->code, 302, 'right status';
# Custom chunked request without callback
$tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('http://www.google.com');
$tx->req->headers->transfer_encoding('chunked');
-my $counter = 1;
-my $chunked = Mojo::Filter::Chunked->new;
-$tx->req->body(
- sub {
- my $self = shift;
- my $chunk = '';
- $chunk = "hello world!" if $counter == 1;
- $chunk = "hello world2!\n\n" if $counter == 2;
- $counter++;
- return $chunked->build($chunk);
+$tx->req->write_chunk(
+ 'hello world!' => sub {
+ shift->write_chunk('hello world2!' => sub { shift->write_chunk('') });
}
);
-$client->process($tx);
+$client->start($tx);
is_deeply([$tx->error], ['Bad Request', 400], 'right error');
is_deeply([$tx->res->error], ['Bad Request', 400], 'right error');
@@ -297,7 +309,7 @@ $client->queue(
$kept_alive = $tx->kept_alive;
}
);
-$client->process;
+$client->start;
ok($done, 'transaction is done');
ok($kept_alive, 'connection was kept alive');
ok($tx->is_done, 'transaction is done');
@@ -307,7 +319,7 @@ $tx->req->url->parse('http://www.apache.org');
ok(!$tx->kept_alive, 'connection was not kept alive');
my ($address, $port, $port2);
($done, $kept_alive) = undef;
-$client->process(
+$client->start(
$tx => sub {
my ($self, $tx) = @_;
$done = $tx->is_done;
@@ -333,7 +345,7 @@ $tx2->req->url->parse('http://www.apache.org');
my $tx3 = Mojo::Transaction::HTTP->new;
$tx3->req->method('GET');
$tx3->req->url->parse('http://www.apache.org');
-$client->process($tx, $tx2, $tx3);
+$client->start($tx, $tx2, $tx3);
ok($tx->is_done, 'transaction is done');
ok($tx2->is_done, 'transaction is done');
ok($tx3->is_done, 'transaction is done');
@@ -349,7 +361,7 @@ $tx->req->url->parse('http://www.apache.org');
$tx2 = Mojo::Transaction::HTTP->new;
$tx2->req->method('GET');
$tx2->req->url->parse('http://www.apache.org');
-$client->process($tx, $tx2);
+$client->start($tx, $tx2);
ok($tx->is_done, 'transaction is done');
ok($tx2->is_done, 'transaction is done');
is($tx->res->code, 200, 'right status');
@@ -369,7 +381,7 @@ $tx3->req->url->parse('http://www.apache.org');
my $tx4 = Mojo::Transaction::HTTP->new;
$tx4->req->method('GET');
$tx4->req->url->parse('http://www.apache.org');
-$client->process($tx, $tx2, $tx3, $tx4);
+$client->start($tx, $tx2, $tx3, $tx4);
ok($tx->is_done, 'transaction is done');
ok($tx2->is_done, 'transaction is done');
ok($tx3->is_done, 'transaction is done');
@@ -5,10 +5,10 @@ use warnings;
use Test::More tests => 3;
-use_ok('Mojo::Content::MultiPart');
-use_ok('Mojo::Content::Single');
+use_ok 'Mojo::Content::MultiPart';
+use_ok 'Mojo::Content::Single';
# No matter how good you are at something,
# there's always about a million people better than you.
my $content = Mojo::Content::Single->new;
-is($content->body_contains('a'), 0, 'content contains "a"');
+is $content->body_contains('a'), 0, 'content contains "a"';
@@ -3,11 +3,11 @@
use strict;
use warnings;
-use Test::More tests => 43;
+use Test::More tests => 59;
# What good is money if it can't inspire terror in your fellow man?
-use_ok('Mojo::Cookie::Request');
-use_ok('Mojo::Cookie::Response');
+use_ok 'Mojo::Cookie::Request';
+use_ok 'Mojo::Cookie::Response';
# Request cookie as string
my $cookie = Mojo::Cookie::Request->new;
@@ -15,11 +15,9 @@ $cookie->name('foo');
$cookie->value('ba =r');
$cookie->path('/test');
$cookie->version(1);
-is("$cookie", 'foo=ba =r; $Path=/test', 'right format');
-is( $cookie->to_string_with_prefix,
- '$Version=1; foo=ba =r; $Path=/test',
- 'right format'
-);
+is "$cookie", 'foo=ba =r; $Path=/test', 'right format';
+is $cookie->to_string_with_prefix, '$Version=1; foo=ba =r; $Path=/test',
+ 'right format';
# Empty cookie
$cookie = Mojo::Cookie::Request->new;
@@ -28,30 +26,40 @@ my $cookies = $cookie->parse();
# Parse normal request cookie
$cookie = Mojo::Cookie::Request->new;
$cookies = $cookie->parse('$Version=1; foo=bar; $Path="/test"');
-is($cookies->[0]->name, 'foo', 'right name');
-is($cookies->[0]->value, 'bar', 'right value');
-is($cookies->[0]->path, '/test', 'right path');
-is($cookies->[0]->version, '1', 'right version');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, 'bar', 'right value';
+is $cookies->[0]->path, '/test', 'right path';
+is $cookies->[0]->version, '1', 'right version';
+
+# Parse request cookie without value
+$cookie = Mojo::Cookie::Request->new;
+$cookies = $cookie->parse('$Version=1; foo; $Path="/test"');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, '', 'no value';
+is $cookies->[0]->path, '/test', 'right path';
+is $cookies->[0]->version, '1', 'right version';
+is $cookies->[0]->to_string_with_prefix, '$Version=1; foo; $Path=/test',
+ 'right result';
# Parse quoted request cookie
$cookie = Mojo::Cookie::Request->new;
$cookies = $cookie->parse('$Version=1; foo="b a\" r\"\\"; $Path="/test"');
-is($cookies->[0]->name, 'foo', 'right name');
-is($cookies->[0]->value, 'b a" r"\\', 'right value');
-is($cookies->[0]->path, '/test', 'right path');
-is($cookies->[0]->version, '1', 'right version');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, 'b a" r"\\', 'right value';
+is $cookies->[0]->path, '/test', 'right path';
+is $cookies->[0]->version, '1', 'right version';
# Parse multiple cookie request
$cookies = Mojo::Cookie::Request->parse(
'$Version=1; foo=bar; $Path=/test; baz=la la; $Path=/tset');
-is($cookies->[0]->name, 'foo', 'right name');
-is($cookies->[0]->value, 'bar', 'right value');
-is($cookies->[0]->path, '/test', 'right path');
-is($cookies->[0]->version, '1', 'right version');
-is($cookies->[1]->name, 'baz', 'right name');
-is($cookies->[1]->value, 'la la', 'right value');
-is($cookies->[1]->path, '/tset', 'right path');
-is($cookies->[1]->version, '1', 'right version');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, 'bar', 'right value';
+is $cookies->[0]->path, '/test', 'right path';
+is $cookies->[0]->version, '1', 'right version';
+is $cookies->[1]->name, 'baz', 'right name';
+is $cookies->[1]->value, 'la la', 'right value';
+is $cookies->[1]->path, '/tset', 'right path';
+is $cookies->[1]->version, '1', 'right version';
# Response cookie as string
$cookie = Mojo::Cookie::Response->new;
@@ -59,7 +67,7 @@ $cookie->name('foo');
$cookie->value('ba r');
$cookie->path('/test');
$cookie->version(1);
-is("$cookie", 'foo=ba r; Version=1; Path=/test', 'right format');
+is "$cookie", 'foo=ba r; Version=1; Path=/test', 'right format';
# Full response cookie as string
$cookie = Mojo::Cookie::Response->new;
@@ -74,31 +82,48 @@ $cookie->secure(1);
$cookie->httponly(1);
$cookie->comment('lalalala');
$cookie->version(1);
-is( "$cookie",
+is "$cookie",
'foo=ba r; Version=1; Domain=kraih.com; Path=/test;'
- . ' Max-Age=60; expires=Thu, 07 Aug 2008 07:07:59 GMT;'
- . ' Port="80 8080"; Secure; HttpOnly; Comment=lalalala',
- 'right format'
-);
+ . ' Max-Age=60; expires=Thu, 07 Aug 2008 07:07:59 GMT;'
+ . ' Port="80 8080"; Secure; HttpOnly; Comment=lalalala', 'right format';
# Parse response cookie
$cookies = Mojo::Cookie::Response->parse(
'foo=ba r; Version=1; Domain=kraih.com; Path=/test; Max-Age=60;'
. ' expires=Thu, 07 Aug 2008 07:07:59 GMT; Port="80 8080"; Secure;'
. ' Comment=lalalala');
-is($cookies->[0]->name, 'foo', 'right name');
-is($cookies->[0]->value, 'ba r', 'right value');
-is($cookies->[0]->domain, 'kraih.com', 'right domain');
-is($cookies->[0]->path, '/test', 'right path');
-is($cookies->[0]->max_age, 60, 'right max age value');
-is( $cookies->[0]->expires,
- 'Thu, 07 Aug 2008 07:07:59 GMT',
- 'right expires value'
-);
-is($cookies->[0]->port, '80 8080', 'right port');
-is($cookies->[0]->secure, '1', 'right secure flag');
-is($cookies->[0]->comment, 'lalalala', 'right comment');
-is($cookies->[0]->version, '1', 'right version');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, 'ba r', 'right value';
+is $cookies->[0]->domain, 'kraih.com', 'right domain';
+is $cookies->[0]->path, '/test', 'right path';
+is $cookies->[0]->max_age, 60, 'right max age value';
+is $cookies->[0]->expires, 'Thu, 07 Aug 2008 07:07:59 GMT',
+ 'right expires value';
+is $cookies->[0]->port, '80 8080', 'right port';
+is $cookies->[0]->secure, '1', 'right secure flag';
+is $cookies->[0]->comment, 'lalalala', 'right comment';
+is $cookies->[0]->version, '1', 'right version';
+
+# Parse response cookie without value
+$cookies = Mojo::Cookie::Response->parse(
+ 'foo; Version=1; Domain=kraih.com; Path=/test; Max-Age=60;'
+ . ' expires=Thu, 07 Aug 2008 07:07:59 GMT; Port="80 8080"; Secure;'
+ . ' Comment=lalalala');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, undef, 'no value';
+is $cookies->[0]->domain, 'kraih.com', 'right domain';
+is $cookies->[0]->path, '/test', 'right path';
+is $cookies->[0]->max_age, 60, 'right max age value';
+is $cookies->[0]->expires, 'Thu, 07 Aug 2008 07:07:59 GMT',
+ 'right expires value';
+is $cookies->[0]->port, '80 8080', 'right port';
+is $cookies->[0]->secure, '1', 'right secure flag';
+is $cookies->[0]->comment, 'lalalala', 'right comment';
+is $cookies->[0]->version, '1', 'right version';
+is $cookies->[0]->to_string,
+ 'foo; Version=1; Domain=kraih.com; Path=/test; Max-Age=60;'
+ . ' expires=Thu, 07 Aug 2008 07:07:59 GMT; Port="80 8080"; Secure;'
+ . ' Comment=lalalala', 'right result';
# Cookie with Max-Age 0 and expires 0
$cookie = Mojo::Cookie::Response->new;
@@ -108,26 +133,21 @@ $cookie->path('/');
$cookie->max_age(0);
$cookie->expires(0);
$cookie->version(1);
-is( "$cookie",
- 'foo=bar; Version=1; Path=/; Max-Age=0;'
- . ' expires=Thu, 01 Jan 1970 00:00:00 GMT',
- 'right format'
-);
+is "$cookie", 'foo=bar; Version=1; Path=/; Max-Age=0;'
+ . ' expires=Thu, 01 Jan 1970 00:00:00 GMT', 'right format';
# Parse response cookie with Max-Age 0 and expires 0
$cookies = Mojo::Cookie::Response->parse(
'foo=bar; Version=1; Domain=kraih.com; Path=/; Max-Age=0;'
. ' expires=Thu, 01 Jan 1970 00:00:00 GMT; Secure; Comment=lalalala');
-is($cookies->[0]->name, 'foo', 'right name');
-is($cookies->[0]->value, 'bar', 'right value');
-is($cookies->[0]->domain, 'kraih.com', 'right domain');
-is($cookies->[0]->path, '/', 'right path');
-is($cookies->[0]->max_age, 0, 'right max age value');
-is( $cookies->[0]->expires,
- 'Thu, 01 Jan 1970 00:00:00 GMT',
- 'right expires value'
-);
-is($cookies->[0]->expires->epoch, 0, 'right expires epoch value');
-is($cookies->[0]->secure, '1', 'right secure flag');
-is($cookies->[0]->comment, 'lalalala', 'right comment');
-is($cookies->[0]->version, '1', 'right version');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, 'bar', 'right value';
+is $cookies->[0]->domain, 'kraih.com', 'right domain';
+is $cookies->[0]->path, '/', 'right path';
+is $cookies->[0]->max_age, 0, 'right max age value';
+is $cookies->[0]->expires, 'Thu, 01 Jan 1970 00:00:00 GMT',
+ 'right expires value';
+is $cookies->[0]->expires->epoch, 0, 'right expires epoch value';
+is $cookies->[0]->secure, '1', 'right secure flag';
+is $cookies->[0]->comment, 'lalalala', 'right comment';
+is $cookies->[0]->version, '1', 'right version';
@@ -8,9 +8,9 @@ use Test::More tests => 24;
# Hello, my name is Mr. Burns. I believe you have a letter for me.
# Okay Mr. Burns, what’s your first name.
# I don’t know.
-use_ok('Mojo::CookieJar');
-use_ok('Mojo::Cookie::Response');
-use_ok('Mojo::URL');
+use_ok 'Mojo::CookieJar';
+use_ok 'Mojo::Cookie::Response';
+use_ok 'Mojo::URL';
my $jar = Mojo::CookieJar->new;
@@ -24,9 +24,9 @@ $jar->add(
)
);
my @cookies = $jar->find(Mojo::URL->new('http://kraih.com/foo'));
-is($cookies[0]->name, 'foo', 'right name');
-is($cookies[0]->value, 'bar', 'right value');
-is($cookies[1], undef, 'no second cookie');
+is $cookies[0]->name, 'foo', 'right name';
+is $cookies[0]->value, 'bar', 'right value';
+is $cookies[1], undef, 'no second cookie';
# Huge cookie
$jar->add(
@@ -38,9 +38,9 @@ $jar->add(
)
);
@cookies = $jar->find(Mojo::URL->new('http://kraih.com/foo'));
-is($cookies[0]->name, 'foo', 'right name');
-is($cookies[0]->value, 'bar', 'right value');
-is($cookies[1], undef, 'no second cookie');
+is $cookies[0]->name, 'foo', 'right name';
+is $cookies[0]->value, 'bar', 'right value';
+is $cookies[1], undef, 'no second cookie';
# Expired cookie
my $expired = Mojo::Cookie::Response->new(
@@ -52,9 +52,9 @@ my $expired = Mojo::Cookie::Response->new(
$expired->expires(time - 1);
$jar->add($expired);
@cookies = $jar->find(Mojo::URL->new('http://labs.kraih.com/foo'));
-is($cookies[0]->name, 'foo', 'right name');
-is($cookies[0]->value, 'bar', 'right value');
-is($cookies[1], undef, 'no second cookie');
+is $cookies[0]->name, 'foo', 'right name';
+is $cookies[0]->value, 'bar', 'right value';
+is $cookies[1], undef, 'no second cookie';
# Multiple cookies
$jar->add(
@@ -67,11 +67,11 @@ $jar->add(
)
);
@cookies = $jar->find(Mojo::URL->new('http://labs.kraih.com/foo'));
-is($cookies[0]->name, 'baz', 'right name');
-is($cookies[0]->value, '23', 'right value');
-is($cookies[1]->name, 'foo', 'right name');
-is($cookies[1]->value, 'bar', 'right value');
-is($cookies[2], undef, 'no third cookie');
+is $cookies[0]->name, 'baz', 'right name';
+is $cookies[0]->value, '23', 'right value';
+is $cookies[1]->name, 'foo', 'right name';
+is $cookies[1]->value, 'bar', 'right value';
+is $cookies[2], undef, 'no third cookie';
# Multiple cookies with leading dot
$jar->add(
@@ -83,11 +83,11 @@ $jar->add(
)
);
@cookies = $jar->find(Mojo::URL->new('http://labs.kraih.com/fo'));
-is($cookies[0]->name, 'baz', 'right name');
-is($cookies[0]->value, '23', 'right value');
-is($cookies[1]->name, 'this', 'right name');
-is($cookies[1]->value, 'that', 'right value');
-is($cookies[2], undef, 'no third cookie');
+is $cookies[0]->name, 'baz', 'right name';
+is $cookies[0]->value, '23', 'right value';
+is $cookies[1]->name, 'this', 'right name';
+is $cookies[1]->value, 'that', 'right value';
+is $cookies[2], undef, 'no third cookie';
# Replace cookie
$jar = Mojo::CookieJar->new;
@@ -108,5 +108,5 @@ $jar->add(
)
);
@cookies = $jar->find(Mojo::URL->new('http://kraih.com/foo'));
-is($cookies[0]->value, 'bar2', 'right value');
-is($cookies[1], undef, 'no second cookie');
+is $cookies[0]->value, 'bar2', 'right value';
+is $cookies[1], undef, 'no second cookie';
@@ -1,149 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-
-use Test::More;
-
-use Mojo::Client;
-use Mojo::Transaction::HTTP;
-use Test::Mojo::Server;
-
-plan skip_all => 'set TEST_DAEMON to enable this test (developer only!)'
- unless $ENV{TEST_DAEMON};
-plan tests => 43;
-
-# Daddy, I'm scared. Too scared to even wet my pants.
-# Just relax and it'll come, son.
-use_ok('Mojo::Server::Daemon');
-
-# Test sane Mojo::Server subclassing capabilities
-my $daemon = Mojo::Server::Daemon->new;
-my $max = $daemon->max_clients;
-$daemon = Mojo::Server::Daemon->new(max_clients => $max + 10);
-is($daemon->max_clients, $max + 10, 'right max clients value');
-
-# Start
-my $server = Test::Mojo::Server->new;
-$server->start_daemon_ok;
-my $port = $server->port;
-my $client = Mojo::Client->new;
-
-# Single request without keep alive
-my $tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/0/");
-$tx->req->headers->connection('close');
-$client->process($tx);
-ok($tx->is_done, 'transaction is done');
-is($tx->res->code, 200, 'right status');
-like($tx->res->headers->connection, qr/close/i, 'right "Connection" header');
-like($tx->res->body, qr/Mojo/, 'right content');
-
-# Multiple requests
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/1/");
-my $tx2 = Mojo::Transaction::HTTP->new;
-$tx2->req->method('GET');
-$tx2->req->url->parse("http://127.0.0.1:$port/2/");
-$tx2->req->headers->expect('fun');
-$tx2->req->body('foo bar baz');
-my $tx3 = Mojo::Transaction::HTTP->new;
-$tx3->req->method('GET');
-$tx3->req->url->parse("http://127.0.0.1:$port/3/");
-my $tx4 = Mojo::Transaction::HTTP->new;
-$tx4->req->method('GET');
-$tx4->req->url->parse("http://127.0.0.1:$port/4/");
-$client->process($tx, $tx2, $tx3, $tx4);
-ok($tx->is_done, 'transaction is done');
-ok($tx2->is_done, 'transaction is done');
-ok($tx3->is_done, 'transaction is done');
-ok($tx4->is_done, 'transaction is done');
-is($tx->res->code, 200, 'right status');
-is($tx2->res->code, 200, 'right status');
-is($tx3->res->code, 200, 'right status');
-is($tx4->res->code, 200, 'right status');
-like($tx2->res->content->asset->slurp, qr/Mojo/, 'right content');
-
-# Request
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/5/");
-$tx->req->headers->expect('fun');
-$tx->req->body('Hello Mojo!');
-$client->process($tx);
-is($tx->res->code, 200, 'right status');
-like($tx->res->headers->connection,
- qr/Keep-Alive/i, 'right "Connection" header');
-like($tx->res->body, qr/Mojo/, 'right content');
-
-# Second keep alive request
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/6/");
-$client->process($tx);
-is($tx->res->code, 200, 'right status');
-is($tx->kept_alive, 1, 'connection was alive');
-like($tx->res->headers->connection,
- qr/Keep-Alive/i, 'right "Connection" header');
-like($tx->res->body, qr/Mojo/, 'right content');
-
-# Third keep alive request
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/7/");
-$client->process($tx);
-is($tx->res->code, 200, 'right status');
-is($tx->kept_alive, 1, 'connection was kept alive');
-like($tx->res->headers->connection,
- qr/Keep-Alive/i, 'right "Connection" header');
-like($tx->res->body, qr/Mojo/, 'right content');
-
-# Multiple requests
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/8/");
-$tx2 = Mojo::Transaction::HTTP->new;
-$tx2->req->method('GET');
-$tx2->req->url->parse("http://127.0.0.1:$port/9/");
-$client->process($tx, $tx2);
-ok($tx->is_done, 'transaction is done');
-ok($tx2->is_done, 'transaction is done');
-is($tx->res->code, 200, 'right status');
-is($tx2->res->code, 200, 'right status');
-like($tx2->res->content->asset->slurp, qr/Mojo/, 'right content');
-
-# Multiple requests with a chunked response
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/10/");
-$tx2 = Mojo::Transaction::HTTP->new;
-$tx2->req->method('GET');
-$tx2->req->url->parse("http://127.0.0.1:$port/11/");
-$tx2->req->headers->expect('fun');
-$tx2->req->body('foo bar baz');
-$tx3 = Mojo::Transaction::HTTP->new;
-$tx3->req->method('GET');
-$tx3->req->url->parse(
- "http://127.0.0.1:$port/diag/chunked_params?a=foo&b=12");
-$tx4 = Mojo::Transaction::HTTP->new;
-$tx4->req->method('GET');
-$tx4->req->url->parse("http://127.0.0.1:$port/13/");
-$client->process($tx, $tx2, $tx3, $tx4);
-ok($tx->is_done, 'transaction is done');
-ok($tx2->is_done, 'transaction is done');
-ok($tx3->is_done, 'transaction is done');
-ok($tx4->is_done, 'transaction is done');
-is($tx->res->code, 200, 'right status');
-is($tx2->res->code, 200, 'right status');
-is($tx3->res->code, 200, 'right status');
-is($tx4->res->code, 200, 'right status');
-like($tx2->res->content->asset->slurp, qr/Mojo/, 'right content');
-is($tx3->res->content->asset->slurp, 'foo12', 'right content');
-
-# Stop
-$server->stop_server_ok;
@@ -1,37 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-# Disable epoll, kqueue and IPv6
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-
-use Test::More;
-
-use Mojo::Client;
-use Mojo::Transaction::HTTP;
-use Test::Mojo::Server;
-
-plan skip_all => 'set TEST_PREFORK to enable this test (developer only!)'
- unless $ENV{TEST_PREFORK};
-plan tests => 5;
-
-# I ate the blue ones... they taste like burning.
-use_ok('Mojo::Server::Daemon::Prefork');
-
-# Start
-my $server = Test::Mojo::Server->new;
-$server->start_daemon_prefork_ok;
-
-# Request
-my $port = $server->port;
-my $tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse("http://127.0.0.1:$port/");
-my $client = Mojo::Client->new;
-$client->process($tx);
-is($tx->res->code, 200, 'right status');
-like($tx->res->body, qr/Mojo/, 'right content');
-
-# Stop
-$server->stop_server_ok;
@@ -6,32 +6,32 @@ use warnings;
use Test::More tests => 10;
# Can't we have one meeting that doesn't end with digging up a corpse?
-use_ok('Mojo::Date');
+use_ok 'Mojo::Date';
# RFC822/1123
my $date = Mojo::Date->new('Sun, 06 Nov 1994 08:49:37 GMT');
-is($date->epoch, 784111777, 'right epoch value');
+is $date->epoch, 784111777, 'right epoch value';
# RFC850/1036
-is($date->parse('Sunday, 06-Nov-94 08:49:37 GMT')->epoch,
- 784111777, 'right epoch value');
+is $date->parse('Sunday, 06-Nov-94 08:49:37 GMT')->epoch,
+ 784111777, 'right epoch value';
# ANSI C asctime()
-is($date->parse('Sun Nov 6 08:49:37 1994')->epoch,
- 784111777, 'right epoch value');
+is $date->parse('Sun Nov 6 08:49:37 1994')->epoch,
+ 784111777, 'right epoch value';
# to_string
$date->parse(784111777);
-is("$date", 'Sun, 06 Nov 1994 08:49:37 GMT', 'right format');
+is "$date", 'Sun, 06 Nov 1994 08:49:37 GMT', 'right format';
# Zero time checks
$date->parse(0);
-is($date->epoch, 0, 'right epoch value');
-is("$date", 'Thu, 01 Jan 1970 00:00:00 GMT', 'right format');
-is($date->parse('Thu, 01 Jan 1970 00:00:00 GMT')->epoch,
- 0, 'right epoch value');
+is $date->epoch, 0, 'right epoch value';
+is "$date", 'Thu, 01 Jan 1970 00:00:00 GMT', 'right format';
+is $date->parse('Thu, 01 Jan 1970 00:00:00 GMT')->epoch,
+ 0, 'right epoch value';
# Negative epoch value
$date = Mojo::Date->new;
-ok($date->parse('Mon, 01 Jan 1900 00:00:00'), 'right format');
-is($date->epoch, undef, 'no epoch value');
+ok $date->parse('Mon, 01 Jan 1900 00:00:00'), 'right format';
+is $date->epoch, undef, 'no epoch value';
@@ -5,51 +5,70 @@ use warnings;
use utf8;
-use Test::More tests => 155;
+use Test::More tests => 316;
# Homer gave me a kidney: it wasn't his, I didn't need it,
# and it came postage due- but I appreciated the gesture!
-use_ok('Mojo::DOM');
+use_ok 'Mojo::DOM';
+use_ok 'ojo';
my $dom = Mojo::DOM->new;
+# ojo
+is x('<div>Hello ♥!</div>')->at('div')->text, 'Hello ♥!', 'right text';
+
# Simple (basics)
$dom->parse('<div><div id="a">A</div><div id="b">B</div></div>');
-is($dom->at('#b')->text, 'B', 'right text');
+is $dom->at('#b')->text, 'B', 'right text';
my @div;
$dom->find('div[id]')->each(sub { push @div, shift->text });
-is_deeply(\@div, [qw/A B/], 'found all div elements with id');
+is_deeply \@div, [qw/A B/], 'found all div elements with id';
+@div = ();
+$dom->find('div[id]')->each(sub { push @div, $_->text });
+is_deeply \@div, [qw/A B/], 'found all div elements with id';
+@div = ();
+$dom->find('div[id]')->until(sub { push @div, shift->text; @div == 1 });
+is_deeply \@div, [qw/A/], 'found first div elements with id';
+@div = ();
+$dom->find('div[id]')->until(sub { pop == 1 && push @div, $_->text });
+is_deeply \@div, [qw/A/], 'found first div elements with id';
+@div = ();
+$dom->find('div[id]')->while(sub { push @div, shift->text; @div < 1 });
+is_deeply \@div, [qw/A/], 'found first div elements with id';
+@div = ();
+$dom->find('div[id]')->while(sub { pop() < 2 && push @div, $_->text });
+is_deeply \@div, [qw/A/], 'found first div elements with id';
# Simple nesting (tree structure)
$dom->parse(<<EOF);
<foo><bar a="b<c">ju<baz a23>s<bazz />t</bar>works</foo>
EOF
-is($dom->tree->[0], 'root', 'right element');
-is($dom->tree->[1]->[0], 'tag', 'right element');
-is($dom->tree->[1]->[1], 'foo', 'right tag');
-is_deeply($dom->tree->[1]->[2], {}, 'empty attributes');
-is($dom->tree->[1]->[3], $dom->tree, 'right parent');
-is($dom->tree->[1]->[4]->[0], 'tag', 'right element');
-is($dom->tree->[1]->[4]->[1], 'bar', 'right tag');
-is_deeply($dom->tree->[1]->[4]->[2], {a => 'b<c'}, 'right attributes');
-is($dom->tree->[1]->[4]->[3], $dom->tree->[1], 'right parent');
-is($dom->tree->[1]->[4]->[4]->[0], 'text', 'right element');
-is($dom->tree->[1]->[4]->[4]->[1], 'ju', 'right text');
-is($dom->tree->[1]->[4]->[5]->[0], 'tag', 'right element');
-is($dom->tree->[1]->[4]->[5]->[1], 'baz', 'right tag');
-is_deeply($dom->tree->[1]->[4]->[5]->[2], {a23 => undef}, 'right attributes');
-is($dom->tree->[1]->[4]->[5]->[3], $dom->tree->[1]->[4], 'right parent');
-is($dom->tree->[1]->[4]->[6]->[0], 'text', 'right element');
-is($dom->tree->[1]->[4]->[6]->[1], 's', 'right text');
-is($dom->tree->[1]->[4]->[7]->[0], 'tag', 'right element');
-is($dom->tree->[1]->[4]->[7]->[1], 'bazz', 'right tag');
-is_deeply($dom->tree->[1]->[4]->[7]->[2], {}, 'empty attributes');
-is($dom->tree->[1]->[4]->[7]->[3], $dom->tree->[1]->[4], 'right parent');
-is($dom->tree->[1]->[4]->[8]->[0], 'text', 'right element');
-is($dom->tree->[1]->[4]->[8]->[1], 't', 'right text');
-is($dom->tree->[1]->[5]->[0], 'text', 'right element');
-is($dom->tree->[1]->[5]->[1], 'works', 'right text');
-is("$dom", <<EOF, 'stringified right');
+is $dom->tree->[0], 'root', 'right element';
+is $dom->tree->[1]->[0], 'tag', 'right element';
+is $dom->tree->[1]->[1], 'foo', 'right tag';
+is_deeply $dom->tree->[1]->[2], {}, 'empty attributes';
+is $dom->tree->[1]->[3], $dom->tree, 'right parent';
+is $dom->tree->[1]->[4]->[0], 'tag', 'right element';
+is $dom->tree->[1]->[4]->[1], 'bar', 'right tag';
+is_deeply $dom->tree->[1]->[4]->[2], {a => 'b<c'}, 'right attributes';
+is $dom->tree->[1]->[4]->[3], $dom->tree->[1], 'right parent';
+is $dom->tree->[1]->[4]->[4]->[0], 'text', 'right element';
+is $dom->tree->[1]->[4]->[4]->[1], 'ju', 'right text';
+is $dom->tree->[1]->[4]->[5]->[0], 'tag', 'right element';
+is $dom->tree->[1]->[4]->[5]->[1], 'baz', 'right tag';
+is_deeply $dom->tree->[1]->[4]->[5]->[2], {a23 => undef}, 'right attributes';
+is $dom->tree->[1]->[4]->[5]->[3], $dom->tree->[1]->[4], 'right parent';
+is $dom->tree->[1]->[4]->[6]->[0], 'text', 'right element';
+is $dom->tree->[1]->[4]->[6]->[1], 's', 'right text';
+is $dom->tree->[1]->[4]->[7]->[0], 'tag', 'right element';
+is $dom->tree->[1]->[4]->[7]->[1], 'bazz', 'right tag';
+is_deeply $dom->tree->[1]->[4]->[7]->[2], {}, 'empty attributes';
+is $dom->tree->[1]->[4]->[7]->[3], $dom->tree->[1]->[4], 'right parent';
+is $dom->tree->[1]->[4]->[8]->[0], 'text', 'right element';
+is $dom->tree->[1]->[4]->[8]->[1], 't', 'right text';
+is $dom->tree->[1]->[5]->[0], 'text', 'right element';
+is $dom->tree->[1]->[5]->[1], 'works', 'right text';
+is "$dom", <<EOF, 'stringified right';
<foo><bar a="b<c">ju<baz a23 />s<bazz />t</bar>works</foo>
EOF
@@ -70,9 +89,9 @@ $dom->parse(<<EOF);
more text
</foo>
EOF
-is($dom->tree->[1]->[0], 'doctype', 'right element');
-is($dom->tree->[1]->[1], ' foo', 'right doctype');
-is("$dom", <<EOF, 'stringified right');
+is $dom->tree->[1]->[0], 'doctype', 'right element';
+is $dom->tree->[1]->[1], ' foo', 'right doctype';
+is "$dom", <<EOF, 'stringified right';
<!DOCTYPE foo>
<foo bar="ba<z">
test
@@ -88,21 +107,19 @@ is("$dom", <<EOF, 'stringified right');
</foo>
EOF
my $simple = $dom->at('foo simple.working[class^="wor"]');
-like($simple->parent->all_text,
- qr/test\s+easy\s+works\s+well\s+yada\s+yada\s+more\s+text/);
-is($simple->name, 'simple', 'right name');
-is($simple->attrs->{class}, 'working', 'right class attribute');
-is($simple->text, 'easy', 'right text');
-is($simple->parent->name, 'foo', 'right parent name');
-is($simple->parent->attrs->{bar}, 'ba<z', 'right parent attribute');
-is($simple->parent->children->[1]->name, 'test', 'right sibling');
-is( $simple->to_xml,
- '<simple class="working">easy</simple>',
- 'stringified right'
-);
-is($dom->at('test#test')->name, 'test', 'right name');
-is($dom->at('[class$="ing"]')->name, 'simple', 'right name');
-is($dom->at('[class="working"]')->name, 'simple', 'right name');
+like $simple->parent->all_text,
+ qr/test\s+easy\s+works\s+well\s+yada\s+yada\s+more\s+text/;
+is $simple->type, 'simple', 'right type';
+is $simple->attrs->{class}, 'working', 'right class attribute';
+is $simple->text, 'easy', 'right text';
+is $simple->parent->type, 'foo', 'right parent type';
+is $simple->parent->attrs->{bar}, 'ba<z', 'right parent attribute';
+is $simple->parent->children->[1]->type, 'test', 'right sibling';
+is $simple->to_xml, '<simple class="working">easy</simple>',
+ 'stringified right';
+is $dom->at('test#test')->type, 'test', 'right type';
+is $dom->at('[class$="ing"]')->type, 'simple', 'right type';
+is $dom->at('[class="working"]')->type, 'simple', 'right type';
# Deep nesting (parent combinator)
$dom->parse(<<EOF);
@@ -129,133 +146,147 @@ $dom->parse(<<EOF);
</html>
EOF
my $p = $dom->find('body > #container > div p[id]');
-is($p->[0]->attrs->{id}, 'foo', 'right id attribute');
-is($p->[1], undef, 'no second result');
+is $p->[0]->attrs->{id}, 'foo', 'right id attribute';
+is $p->[1], undef, 'no second result';
my @p;
@div = ();
$dom->find('div')->each(sub { push @div, $_->attrs->{id} })->find('p')
->each(sub { push @p, $_->attrs->{id} });
-is_deeply(\@p, [qw/foo bar/], 'found all p elements');
+is_deeply \@p, [qw/foo bar/], 'found all p elements';
my $ids = [qw/container header logo buttons buttons content/];
-is_deeply(\@div, $ids, 'found all div elements');
+is_deeply \@div, $ids, 'found all div elements';
# Script tag
$dom->parse(<<EOF);
<script type="text/javascript" charset="utf-8">alert('lalala');</script>
EOF
-is($dom->at('script')->text, "alert('lalala');", 'right script content');
+is $dom->at('script')->text, "alert('lalala');", 'right script content';
# HTML5 (unquoted values)
$dom->parse(qq/<div id = test foo ="bar" class=tset>works<\/div>/);
-is($dom->at('#test')->text, 'works', 'right text');
-is($dom->at('div')->text, 'works', 'right text');
-is($dom->at('[foo="bar"]')->text, 'works', 'right text');
-is($dom->at('[foo="ba"]'), undef, 'no result');
-is($dom->at('.tset')->text, 'works', 'right text');
+is $dom->at('#test')->text, 'works', 'right text';
+is $dom->at('div')->text, 'works', 'right text';
+is $dom->at('[foo="bar"]')->text, 'works', 'right text';
+is $dom->at('[foo="ba"]'), undef, 'no result';
+is $dom->at('.tset')->text, 'works', 'right text';
# HTML1 (single quotes, uppercase tags and whitespace in attributes)
$dom->parse(qq/<DIV id = 'test' foo ='bar' class= "tset">works<\/DIV>/);
-is($dom->at('#test')->text, 'works', 'right text');
-is($dom->at('div')->text, 'works', 'right text');
-is($dom->at('[foo="bar"]')->text, 'works', 'right text');
-is($dom->at('[foo="ba"]'), undef, 'no result');
-is($dom->at('.tset')->text, 'works', 'right text');
+is $dom->at('#test')->text, 'works', 'right text';
+is $dom->at('div')->text, 'works', 'right text';
+is $dom->at('[foo="bar"]')->text, 'works', 'right text';
+is $dom->at('[foo="ba"]'), undef, 'no result';
+is $dom->at('.tset')->text, 'works', 'right text';
# Already decoded unicode snowman and quotes in selector
-$dom->charset(undef)->parse('<div id="sno"wman">☃</div>');
-is($dom->at('[id="sno\"wman"]')->text, '☃', 'right text');
+$dom->parse('<div id="sno"wman">☃</div>');
+is $dom->at('[id="sno\"wman"]')->text, '☃', 'right text';
# Unicode and escaped selectors
$dom->parse(
qq/<p><div id="☃x">Snowman<\/div><div class="x ♥">Heart<\/div><\/p>/);
-is($dom->at("#\\\n\\002603x")->text, 'Snowman', 'right text');
-is($dom->at('#\\2603 x')->text, 'Snowman', 'right text');
-is($dom->at("#\\\n\\2603 x")->text, 'Snowman', 'right text');
-is($dom->at(qq/[id="\\\n\\2603 x"]/)->text, 'Snowman', 'right text');
-is($dom->at(qq/[id="\\\n\\002603x"]/)->text, 'Snowman', 'right text');
-is($dom->at(qq/[id="\\\\2603 x"]/)->text, 'Snowman', 'right text');
-is($dom->at("p #\\\n\\002603x")->text, 'Snowman', 'right text');
-is($dom->at('p #\\2603 x')->text, 'Snowman', 'right text');
-is($dom->at("p #\\\n\\2603 x")->text, 'Snowman', 'right text');
-is($dom->at(qq/p [id="\\\n\\2603 x"]/)->text, 'Snowman', 'right text');
-is($dom->at(qq/p [id="\\\n\\002603x"]/)->text, 'Snowman', 'right text');
-is($dom->at(qq/p [id="\\\\2603 x"]/)->text, 'Snowman', 'right text');
-is($dom->at('#☃x')->text, 'Snowman', 'right text');
-is($dom->at('div#☃x')->text, 'Snowman', 'right text');
-is($dom->at('p div#☃x')->text, 'Snowman', 'right text');
-is($dom->at('[id^="☃"]')->text, 'Snowman', 'right text');
-is($dom->at('div[id^="☃"]')->text, 'Snowman', 'right text');
-is($dom->at('p div[id^="☃"]')->text, 'Snowman', 'right text');
-is($dom->at('p > div[id^="☃"]')->text, 'Snowman', 'right text');
-is($dom->at(".\\\n\\002665")->text, 'Heart', 'right text');
-is($dom->at('.\\2665')->text, 'Heart', 'right text');
-is($dom->at("p .\\\n\\002665")->text, 'Heart', 'right text');
-is($dom->at('p .\\2665')->text, 'Heart', 'right text');
-is($dom->at(qq/p [class\$="\\\n\\002665"]/)->text, 'Heart', 'right text');
-is($dom->at(qq/p [class\$="\\2665"]/)->text, 'Heart', 'right text');
-is($dom->at(qq/[class\$="\\\n\\002665"]/)->text, 'Heart', 'right text');
-is($dom->at(qq/[class\$="\\2665"]/)->text, 'Heart', 'right text');
-is($dom->at('.x')->text, 'Heart', 'right text');
-is($dom->at('p .x')->text, 'Heart', 'right text');
-is($dom->at('.♥')->text, 'Heart', 'right text');
-is($dom->at('p .♥')->text, 'Heart', 'right text');
-is($dom->at('div.♥')->text, 'Heart', 'right text');
-is($dom->at('p div.♥')->text, 'Heart', 'right text');
-is($dom->at('[class$="♥"]')->text, 'Heart', 'right text');
-is($dom->at('div[class$="♥"]')->text, 'Heart', 'right text');
-is($dom->at('p div[class$="♥"]')->text, 'Heart', 'right text');
-is($dom->at('p > div[class$="♥"]')->text, 'Heart', 'right text');
+is $dom->at("#\\\n\\002603x")->text, 'Snowman', 'right text';
+is $dom->at('#\\2603 x')->text, 'Snowman', 'right text';
+is $dom->at("#\\\n\\2603 x")->text, 'Snowman', 'right text';
+is $dom->at(qq/[id="\\\n\\2603 x"]/)->text, 'Snowman', 'right text';
+is $dom->at(qq/[id="\\\n\\002603x"]/)->text, 'Snowman', 'right text';
+is $dom->at(qq/[id="\\\\2603 x"]/)->text, 'Snowman', 'right text';
+is $dom->at("p #\\\n\\002603x")->text, 'Snowman', 'right text';
+is $dom->at('p #\\2603 x')->text, 'Snowman', 'right text';
+is $dom->at("p #\\\n\\2603 x")->text, 'Snowman', 'right text';
+is $dom->at(qq/p [id="\\\n\\2603 x"]/)->text, 'Snowman', 'right text';
+is $dom->at(qq/p [id="\\\n\\002603x"]/)->text, 'Snowman', 'right text';
+is $dom->at(qq/p [id="\\\\2603 x"]/)->text, 'Snowman', 'right text';
+is $dom->at('#☃x')->text, 'Snowman', 'right text';
+is $dom->at('div#☃x')->text, 'Snowman', 'right text';
+is $dom->at('p div#☃x')->text, 'Snowman', 'right text';
+is $dom->at('[id^="☃"]')->text, 'Snowman', 'right text';
+is $dom->at('div[id^="☃"]')->text, 'Snowman', 'right text';
+is $dom->at('p div[id^="☃"]')->text, 'Snowman', 'right text';
+is $dom->at('p > div[id^="☃"]')->text, 'Snowman', 'right text';
+is $dom->at(".\\\n\\002665")->text, 'Heart', 'right text';
+is $dom->at('.\\2665')->text, 'Heart', 'right text';
+is $dom->at("p .\\\n\\002665")->text, 'Heart', 'right text';
+is $dom->at('p .\\2665')->text, 'Heart', 'right text';
+is $dom->at(qq/p [class\$="\\\n\\002665"]/)->text, 'Heart', 'right text';
+is $dom->at(qq/p [class\$="\\2665"]/)->text, 'Heart', 'right text';
+is $dom->at(qq/[class\$="\\\n\\002665"]/)->text, 'Heart', 'right text';
+is $dom->at(qq/[class\$="\\2665"]/)->text, 'Heart', 'right text';
+is $dom->at('.x')->text, 'Heart', 'right text';
+is $dom->at('p .x')->text, 'Heart', 'right text';
+is $dom->at('.♥')->text, 'Heart', 'right text';
+is $dom->at('p .♥')->text, 'Heart', 'right text';
+is $dom->at('div.♥')->text, 'Heart', 'right text';
+is $dom->at('p div.♥')->text, 'Heart', 'right text';
+is $dom->at('[class$="♥"]')->text, 'Heart', 'right text';
+is $dom->at('div[class$="♥"]')->text, 'Heart', 'right text';
+is $dom->at('p div[class$="♥"]')->text, 'Heart', 'right text';
+is $dom->at('p > div[class$="♥"]')->text, 'Heart', 'right text';
+is $dom->at('[class~="♥"]')->text, 'Heart', 'right text';
+is $dom->at('div[class~="♥"]')->text, 'Heart', 'right text';
+is $dom->at('p div[class~="♥"]')->text, 'Heart', 'right text';
+is $dom->at('p > div[class~="♥"]')->text, 'Heart', 'right text';
+is $dom->at('[class~="x"]')->text, 'Heart', 'right text';
+is $dom->at('div[class~="x"]')->text, 'Heart', 'right text';
+is $dom->at('p div[class~="x"]')->text, 'Heart', 'right text';
+is $dom->at('p > div[class~="x"]')->text, 'Heart', 'right text';
# Looks remotely like HTML
$dom->parse('<!DOCTYPE H "-/W/D HT 4/E">☃<title class=test>♥</title>☃');
-is($dom->at('title')->text, '♥', 'right text');
-is($dom->at('*')->text, '♥', 'right text');
-is($dom->at('.test')->text, '♥', 'right text');
+is $dom->at('title')->text, '♥', 'right text';
+is $dom->at('*')->text, '♥', 'right text';
+is $dom->at('.test')->text, '♥', 'right text';
# Replace elements
$dom->parse('<div>foo<p>lalala</p>bar</div>');
$dom->at('p')->replace('<foo>bar</foo>');
-is("$dom", '<div>foo<foo>bar</foo>bar</div>', 'right text');
+is "$dom", '<div>foo<foo>bar</foo>bar</div>', 'right text';
$dom->at('foo')->replace(Mojo::DOM->new->parse('text'));
-is("$dom", '<div>footextbar</div>', 'right text');
+is "$dom", '<div>footextbar</div>', 'right text';
$dom->parse('<div>foo</div><div>bar</div>');
$dom->find('div')->each(sub { shift->replace('<p>test</p>') });
-is("$dom", '<p>test</p><p>test</p>', 'right text');
+is "$dom", '<p>test</p><p>test</p>', 'right text';
$dom->parse('<div>foo<p>lalala</p>bar</div>');
$dom->replace('♥');
-is("$dom", '♥', 'right text');
+is "$dom", '♥', 'right text';
$dom->replace('<div>foo<p>lalala</p>bar</div>');
-is("$dom", '<div>foo<p>lalala</p>bar</div>', 'right text');
+is "$dom", '<div>foo<p>lalala</p>bar</div>', 'right text';
$dom->replace('');
-is("$dom", '', 'right text');
+is "$dom", '', 'right text';
$dom->replace('<div>foo<p>lalala</p>bar</div>');
-is("$dom", '<div>foo<p>lalala</p>bar</div>', 'right text');
+is "$dom", '<div>foo<p>lalala</p>bar</div>', 'right text';
$dom->find('p')->each(sub { shift->replace('') });
-is("$dom", '<div>foobar</div>', 'right text');
+is "$dom", '<div>foobar</div>', 'right text';
+$dom->parse('<div>♥</div>');
+$dom->at('div')->replace_inner('☃');
+is "$dom", '<div>☃</div>', 'right text';
+$dom->parse('<div>♥</div>');
+$dom->at('div')->replace_inner("\x{2603}");
+is "$dom", '<div>☃</div>', 'right text';
# Replace element content
$dom->parse('<div>foo<p>lalala</p>bar</div>');
-$dom->at('p')->replace_content('bar');
-is("$dom", '<div>foo<p>bar</p>bar</div>', 'right text');
-$dom->at('p')->replace_content(Mojo::DOM->new->parse('text'));
-is("$dom", '<div>foo<p>text</p>bar</div>', 'right text');
+$dom->at('p')->replace_inner('bar');
+is "$dom", '<div>foo<p>bar</p>bar</div>', 'right text';
+$dom->at('p')->replace_inner(Mojo::DOM->new->parse('text'));
+is "$dom", '<div>foo<p>text</p>bar</div>', 'right text';
$dom->parse('<div>foo</div><div>bar</div>');
-$dom->find('div')->each(sub { shift->replace_content('<p>test</p>') });
-is("$dom", '<div><p>test</p></div><div><p>test</p></div>', 'right text');
-$dom->find('p')->each(sub { shift->replace_content('') });
-is("$dom", '<div><p /></div><div><p /></div>', 'right text');
+$dom->find('div')->each(sub { shift->replace_inner('<p>test</p>') });
+is "$dom", '<div><p>test</p></div><div><p>test</p></div>', 'right text';
+$dom->find('p')->each(sub { shift->replace_inner('') });
+is "$dom", '<div><p /></div><div><p /></div>', 'right text';
$dom->parse('<div><p id="☃" /></div>');
-$dom->at('#☃')->replace_content('♥');
-is("$dom", '<div><p id="☃">♥</p></div>', 'right text');
+$dom->at('#☃')->replace_inner('♥');
+is "$dom", '<div><p id="☃">♥</p></div>', 'right text';
$dom->parse('<div>foo<p>lalala</p>bar</div>');
-$dom->replace_content('♥');
-is("$dom", '♥', 'right text');
-$dom->replace_content('<div>foo<p>lalala</p>bar</div>');
-is("$dom", '<div>foo<p>lalala</p>bar</div>', 'right text');
-$dom->replace_content('');
-is("$dom", '', 'right text');
-$dom->replace_content('<div>foo<p>lalala</p>bar</div>');
-is("$dom", '<div>foo<p>lalala</p>bar</div>', 'right text');
+$dom->replace_inner('♥');
+is "$dom", '♥', 'right text';
+$dom->replace_inner('<div>foo<p>lalala</p>bar</div>');
+is "$dom", '<div>foo<p>lalala</p>bar</div>', 'right text';
+$dom->replace_inner('');
+is "$dom", '', 'right text';
+$dom->replace_inner('<div>foo<p>lalala</p>bar</div>');
+is "$dom", '<div>foo<p>lalala</p>bar</div>', 'right text';
# Mixed search and tree walk
$dom->parse(<<EOF);
@@ -269,14 +300,14 @@ EOF
my @data;
for my $tr ($dom->find('table tr')->each) {
for my $td (@{$tr->children}) {
- push @data, $td->name, $td->all_text;
+ push @data, $td->type, $td->all_text;
}
}
-is($data[0], 'td', 'right tag');
-is($data[1], 'text1', 'right text');
-is($data[2], 'td', 'right tag');
-is($data[3], 'text2', 'right text');
-is($data[4], undef, 'no tag');
+is $data[0], 'td', 'right tag';
+is $data[1], 'text1', 'right text';
+is $data[2], 'td', 'right tag';
+is $data[3], 'text2', 'right text';
+is $data[4], undef, 'no tag';
# RSS
$dom->parse(<<EOF);
@@ -304,12 +335,16 @@ $dom->parse(<<EOF);
</channel>
</rss>
EOF
-is($dom->find('rss')->[0]->attrs->{version}, '2.0', 'right version');
-is($dom->at('extension')->attrs->{'foo:id'}, 'works', 'right id');
-like($dom->at('#works')->text, qr/\[awesome\]\]/, 'right text');
-like($dom->at('[id="works"]')->text, qr/\[awesome\]\]/, 'right text');
-is($dom->find('description')->[1]->text, '<p>trololololo>', 'right text');
-is($dom->at('pubdate')->text, 'Mon, 12 Jul 2010 20:42:00', 'right text');
+is $dom->find('rss')->[0]->attrs->{version}, '2.0', 'right version';
+is $dom->at('extension')->attrs->{'foo:id'}, 'works', 'right id';
+like $dom->at('#works')->text, qr/\[awesome\]\]/, 'right text';
+like $dom->at('[id="works"]')->text, qr/\[awesome\]\]/, 'right text';
+is $dom->find('description')->[1]->text, '<p>trololololo>', 'right text';
+is $dom->at('pubdate')->text, 'Mon, 12 Jul 2010 20:42:00', 'right text';
+like $dom->at('[id*="ork"]')->text, qr/\[awesome\]\]/, 'right text';
+like $dom->at('[id*="orks"]')->text, qr/\[awesome\]\]/, 'right text';
+like $dom->at('[id*="work"]')->text, qr/\[awesome\]\]/, 'right text';
+like $dom->at('[id*="or"]')->text, qr/\[awesome\]\]/, 'right text';
# Yadis
$dom->parse(<<'EOF');
@@ -325,14 +360,14 @@ $dom->parse(<<'EOF');
</XRD>
</XRDS>
EOF
-is($dom->at('xrds')->namespace, 'xri://$xrds', 'right namespace');
-is($dom->at('xrd')->namespace, 'xri://$xrd*($v*2.0)', 'right namespace');
+is $dom->at('xrds')->namespace, 'xri://$xrds', 'right namespace';
+is $dom->at('xrd')->namespace, 'xri://$xrd*($v*2.0)', 'right namespace';
my $s = $dom->find('xrds xrd service');
-is($s->[0]->at('type')->text, 'http://o.r.g/sso/2.0', 'right text');
-is($s->[0]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace');
-is($s->[1]->at('type')->text, 'http://o.r.g/sso/1.0', 'right text');
-is($s->[1]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace');
-is($s->[2], undef, 'no text');
+is $s->[0]->at('type')->text, 'http://o.r.g/sso/2.0', 'right text';
+is $s->[0]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace';
+is $s->[1]->at('type')->text, 'http://o.r.g/sso/1.0', 'right text';
+is $s->[1]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace';
+is $s->[2], undef, 'no text';
# Yadis (with namespace)
$dom->parse(<<'EOF');
@@ -356,42 +391,465 @@ $dom->parse(<<'EOF');
</XRD>
</xrds:XRDS>
EOF
-is($dom->at('xrds')->namespace, 'xri://$xrds', 'right namespace');
-is($dom->at('xrd')->namespace, 'xri://$xrd*($v*2.0)', 'right namespace');
+is $dom->at('xrds')->namespace, 'xri://$xrds', 'right namespace';
+is $dom->at('xrd')->namespace, 'xri://$xrd*($v*2.0)', 'right namespace';
$s = $dom->find('xrds xrd service');
-is($s->[0]->at('type')->text, 'http://o.r.g/sso/3.0', 'right text');
-is($s->[0]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace');
-is($s->[1]->at('type')->text, 'http://o.r.g/sso/4.0', 'right text');
-is($s->[1]->namespace, 'xri://$xrds', 'right namespace');
-is($s->[2]->at('type')->text, 'http://o.r.g/sso/2.0', 'right text');
-is($s->[2]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace');
-is($s->[3]->at('type')->text, 'http://o.r.g/sso/1.0', 'right text');
-is($s->[3]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace');
-is($s->[4], undef, 'no text');
+is $s->[0]->at('type')->text, 'http://o.r.g/sso/3.0', 'right text';
+is $s->[0]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace';
+is $s->[1]->at('type')->text, 'http://o.r.g/sso/4.0', 'right text';
+is $s->[1]->namespace, 'xri://$xrds', 'right namespace';
+is $s->[2]->at('type')->text, 'http://o.r.g/sso/2.0', 'right text';
+is $s->[2]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace';
+is $s->[3]->at('type')->text, 'http://o.r.g/sso/1.0', 'right text';
+is $s->[3]->namespace, 'xri://$xrd*($v*2.0)', 'right namespace';
+is $s->[4], undef, 'no text';
# Result and iterator order
$dom->parse('<a><b>1</b></a><b>2</b><b>3</b>');
my @numbers;
$dom->find("b")->each(sub { push @numbers, pop, shift->text });
-is_deeply(\@numbers, [1, 1, 2, 2, 3, 3], 'right order');
+is_deeply \@numbers, [1, 1, 2, 2, 3, 3], 'right order';
# Attributes on multiple lines
$dom->parse("<div test=23 id='a' \n class='x' foo=bar />");
-is($dom->at('div.x')->attrs->{test}, 23, 'right attribute');
-is($dom->at('[foo="bar"]')->attrs->{class}, 'x', 'right attribute');
+is $dom->at('div.x')->attrs->{test}, 23, 'right attribute';
+is $dom->at('[foo="bar"]')->attrs->{class}, 'x', 'right attribute';
# Markup characters in attribute values
$dom->parse(qq/<div id="<a>" \n test='='>Test<div id='><' \/><\/div>/);
-is($dom->at('div[id="<a>"]')->attrs->{test}, '=', 'right attribute');
-is($dom->at('[id="<a>"]')->text, 'Test', 'right text');
-is($dom->at('[id="><"]')->attrs->{id}, '><', 'right attribute');
+is $dom->at('div[id="<a>"]')->attrs->{test}, '=', 'right attribute';
+is $dom->at('[id="<a>"]')->text, 'Test', 'right text';
+is $dom->at('[id="><"]')->attrs->{id}, '><', 'right attribute';
# Empty attributes
$dom->parse(qq/<div test="" test2='' \/>/);
-is($dom->at('div')->attrs->{test}, '', 'empty attribute value');
-is($dom->at('div')->attrs->{test2}, '', 'empty attribute value');
+is $dom->at('div')->attrs->{test}, '', 'empty attribute value';
+is $dom->at('div')->attrs->{test2}, '', 'empty attribute value';
# Whitespaces before closing bracket
$dom->parse(qq/<div >content<\/div>/);
-ok($dom->at('div'), 'tag found');
-is($dom->at('div')->text, 'content', 'right text');
+ok $dom->at('div'), 'tag found';
+is $dom->at('div')->text, 'content', 'right text';
+is $dom->at('div')->inner_xml, 'content', 'right text';
+
+# Class with hyphen
+$dom->parse(qq/<div class="a">A<\/div><div class="a-1">A1<\/div>/);
+@div = ();
+$dom->find('.a')->each(sub { push @div, shift->text });
+is_deeply \@div, ['A'], 'found first element only';
+@div = ();
+$dom->find('.a-1')->each(sub { push @div, shift->text });
+is_deeply \@div, ['A1'], 'found last element only';
+
+# Defined but false text
+$dom->parse(
+ '<div><div id="a">A</div><div id="b">B</div></div><div id="0">0</div>');
+@div = ();
+$dom->find('div[id]')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A B 0/], 'found all div elements with id';
+
+# Empty tags
+$dom->parse('<hr /><br/><br id="br"/><br />');
+is "$dom", '<hr /><br /><br id="br" /><br />', 'right result';
+is $dom->at('br')->inner_xml, '', 'empty result';
+
+# Inner XML
+$dom->parse('<a>xxx<x>x</x>xxx</a>');
+is $dom->at('a')->inner_xml, 'xxx<x>x</x>xxx', 'right result';
+is $dom->inner_xml, '<a>xxx<x>x</x>xxx</a>', 'right result';
+
+# Multiple selectors
+$dom->parse('<div id="a">A</div><div id="b">B</div><div id="c">C</div>');
+@div = ();
+$dom->find('#a, #c')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A C/], 'found all div elements with the right ids';
+@div = ();
+$dom->find('div#a, div#b')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A B/], 'found all div elements with the right ids';
+@div = ();
+$dom->find('div[id="a"], div[id="c"]')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A C/], 'found all div elements with the right ids';
+$dom->parse('<div id="☃">A</div><div id="b">B</div><div id="♥x">C</div>');
+@div = ();
+$dom->find('#☃, #♥x')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A C/], 'found all div elements with the right ids';
+@div = ();
+$dom->find('div#☃, div#b')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A B/], 'found all div elements with the right ids';
+@div = ();
+$dom->find('div[id="☃"], div[id="♥x"]')
+ ->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A C/], 'found all div elements with the right ids';
+
+# Multiple attributes
+$dom->parse(<<EOF);
+<div foo="bar" bar="baz">A</div>
+<div foo="bar">B</div>
+<div foo="bar" bar="baz">C</div>
+<div foo="baz" bar="baz">D</div>
+EOF
+@div = ();
+$dom->find('div[foo="bar"][bar="baz"]')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A C/], 'found all div elements with the right atributes';
+@div = ();
+$dom->find('div[foo^="b"][foo$="r"]')->each(sub { push @div, shift->text });
+is_deeply \@div, [qw/A B C/],
+ 'found all div elements with the right atributes';
+
+# Pseudo classes
+$dom->parse(<<EOF);
+<form action="/foo">
+ <input type="text" name="user" value="test" />
+ <input type="checkbox" checked="checked" name="groovy">
+ <select name="a">
+ <option value="b">b</option>
+ <optgroup label="c">
+ <option value="d">d</option>
+ <option selected="selected" value="e">E</option>
+ <option value="f">f</option>
+ </optgroup>
+ <option value="g">g</option>
+ </select>
+ <input type="submit" value="Ok!" />
+</form>
+EOF
+is($dom->find(':root')->[0]->type, 'form', 'right type');
+is($dom->find('*:root')->[0]->type, 'form', 'right type');
+is($dom->find('form:root')->[0]->type, 'form', 'right type');
+is($dom->find(':root')->[1], undef, 'no element');
+is($dom->find(':checked')->[0]->attrs->{name}, 'groovy', 'right name');
+is($dom->find('option:checked')->[0]->attrs->{value}, 'e', 'right value');
+is($dom->find(':checked')->[1]->text, 'E', 'right text');
+is($dom->find('*:checked')->[1]->text, 'E', 'right text');
+is($dom->find(':checked[value="e"]')->[0]->text, 'E', 'right text');
+is($dom->find('*:checked[value="e"]')->[0]->text, 'E', 'right text');
+is($dom->find('option:checked[value="e"]')->[0]->text, 'E', 'right text');
+is($dom->at('optgroup option:checked[value="e"]')->text, 'E', 'right text');
+is($dom->at('select option:checked[value="e"]')->text, 'E', 'right text');
+is($dom->at('select :checked[value="e"]')->text, 'E', 'right text');
+is($dom->at('optgroup > :checked[value="e"]')->text, 'E', 'right text');
+is($dom->at('select *:checked[value="e"]')->text, 'E', 'right text');
+is($dom->at('optgroup > *:checked[value="e"]')->text, 'E', 'right text');
+is($dom->find(':checked[value="e"]')->[1], undef, 'no element');
+is($dom->find(':empty')->[0]->attrs->{name}, 'user', 'right name');
+is($dom->find('input:empty')->[0]->attrs->{name}, 'user', 'right name');
+is($dom->at(':empty[type^="ch"]')->attrs->{name}, 'groovy', 'right name');
+
+# More pseudo classes
+$dom->parse(<<EOF);
+<ul>
+ <li>A</li>
+ <li>B</li>
+ <li>C</li>
+ <li>D</li>
+ <li>E</li>
+ <li>F</li>
+ <li>G</li>
+ <li>H</li>
+</ul>
+EOF
+my @li;
+$dom->find('li:nth-child(odd)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A C E G/], 'found all odd li elements';
+@li = ();
+$dom->find('li:nth-last-child(odd)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/B D F H/], 'found all odd li elements';
+is($dom->find(':nth-child(odd)')->[0]->type, 'ul', 'right type');
+is($dom->find(':nth-child(odd)')->[1]->text, 'A', 'right text');
+is($dom->find(':nth-child(1)')->[0]->type, 'ul', 'right type');
+is($dom->find(':nth-child(1)')->[1]->text, 'A', 'right text');
+is($dom->find(':nth-last-child(odd)')->[0]->type, 'ul', 'right type');
+is($dom->find(':nth-last-child(odd)')->[-1]->text, 'H', 'right text');
+is($dom->find(':nth-last-child(1)')->[0]->type, 'ul', 'right type');
+is($dom->find(':nth-last-child(1)')->[1]->text, 'H', 'right text');
+@li = ();
+$dom->find('li:nth-child(2n+1)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A C E G/], 'found all odd li elements';
+@li = ();
+$dom->find('li:nth-last-child(2n+1)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/B D F H/], 'found all odd li elements';
+@li = ();
+$dom->find('li:nth-child(even)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/B D F H/], 'found all even li elements';
+@li = ();
+$dom->find('li:nth-last-child(even)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A C E G/], 'found all even li elements';
+@li = ();
+$dom->find('li:nth-child(2n+2)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/B D F H/], 'found all even li elements';
+@li = ();
+$dom->find('li:nth-last-child(2n+2)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A C E G/], 'found all even li elements';
+@li = ();
+$dom->find('li:nth-child(4n+1)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A E/], 'found the right li elements';
+@li = ();
+$dom->find('li:nth-last-child(4n+1)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/D H/], 'found the right li elements';
+@li = ();
+$dom->find('li:nth-child(4n+4)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/D H/], 'found the right li element';
+@li = ();
+$dom->find('li:nth-last-child(4n+4)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A E/], 'found the right li element';
+@li = ();
+$dom->find('li:nth-child(4n)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/D H/], 'found the right li element';
+@li = ();
+$dom->find('li:nth-last-child(4n)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A E/], 'found the right li element';
+@li = ();
+$dom->find('li:nth-child(5n-2)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/C H/], 'found the right li element';
+@li = ();
+$dom->find('li:nth-last-child(5n-2)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A F/], 'found the right li element';
+@li = ();
+$dom->find('li:nth-child(-n+3)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A B C/], 'found first three li elements';
+@li = ();
+$dom->find('li:nth-last-child(-n+3)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/F G H/], 'found last three li elements';
+@li = ();
+$dom->find('li:nth-child(-1n+3)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/A B C/], 'found first three li elements';
+@li = ();
+$dom->find('li:nth-last-child(-1n+3)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/F G H/], 'found first three li elements';
+@li = ();
+$dom->find('li:nth-child(3n)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/C F/], 'found every third li elements';
+@li = ();
+$dom->find('li:nth-last-child(3n)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/C F/], 'found every third li elements';
+@li = ();
+$dom->find('li:nth-child(3)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/C/], 'found third li element';
+@li = ();
+$dom->find('li:nth-last-child(3)')->each(sub { push @li, shift->text });
+is_deeply \@li, [qw/F/], 'found third last li element';
+
+# Even more pseudo classes
+$dom->parse(<<EOF);
+<ul>
+ <li>A</li>
+ <p>B</p>
+ <li class="test ♥">C</li>
+ <p>D</p>
+ <li>E</li>
+ <li>F</li>
+ <p>G</p>
+ <li>H</li>
+ <li>I</li>
+</ul>
+<div>
+ <div class="☃">J</div>
+</div>
+<div>
+ <a href="http://mojolicio.us">Mojo!</a>
+ <div class="☃">K</div>
+ <a href="http://mojolicio.us">Mojolicious!</a>
+</div>
+EOF
+my @e;
+$dom->find('ul :nth-child(odd)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A C E G I/], 'found all odd elements';
+@e = ();
+$dom->find('li:nth-of-type(odd)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A E H/], 'found all odd li elements';
+@e = ();
+$dom->find('li:nth-last-of-type(odd)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/C F I/], 'found all odd li elements';
+@e = ();
+$dom->find('p:nth-of-type(odd)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/B G/], 'found all odd p elements';
+@e = ();
+$dom->find('p:nth-last-of-type(odd)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/B G/], 'found all odd li elements';
+@e = ();
+$dom->find('ul :nth-child(1)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A/], 'found first child';
+@e = ();
+$dom->find('ul :first-child')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A/], 'found first child';
+@e = ();
+$dom->find('p:nth-of-type(1)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/B/], 'found first child';
+@e = ();
+$dom->find('p:first-of-type')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/B/], 'found first child';
+@e = ();
+$dom->find('li:nth-of-type(1)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A/], 'found first child';
+@e = ();
+$dom->find('li:first-of-type')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A/], 'found first child';
+@e = ();
+$dom->find('ul :nth-last-child(-n+1)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/I/], 'found last child';
+@e = ();
+$dom->find('ul :last-child')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/I/], 'found last child';
+@e = ();
+$dom->find('p:nth-last-of-type(-n+1)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/G/], 'found last child';
+@e = ();
+$dom->find('p:last-of-type')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/G/], 'found last child';
+@e = ();
+$dom->find('li:nth-last-of-type(-n+1)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/I/], 'found last child';
+@e = ();
+$dom->find('li:last-of-type')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/I/], 'found last child';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not(li)')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/B/], 'found first p element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not(:first-child)')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/B C/], 'found second and third element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not(.♥)')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A B/], 'found first and second element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not([class$="♥"])')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A B/], 'found first and second element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not(li[class$="♥"])')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A B/], 'found first and second element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not([class$="♥"][class^="test"])')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A B/], 'found first and second element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not(*[class$="♥"])')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/A B/], 'found first and second element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not(:nth-child(-n+2))')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/C/], 'found third element';
+@e = ();
+$dom->find('ul :nth-child(-n+3):not(:nth-child(1)):not(:nth-child(2))')
+ ->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/C/], 'found third element';
+@e = ();
+$dom->find(':only-child')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/J/], 'found only child';
+@e = ();
+$dom->find('div :only-of-type')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/J K/], 'found only child';
+@e = ();
+$dom->find('div:only-child')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/J/], 'found only child';
+@e = ();
+$dom->find('div div:only-of-type')->each(sub { push @e, shift->text });
+is_deeply \@e, [qw/J K/], 'found only child';
+
+# Sibling combinator
+$dom->parse(<<EOF);
+<ul>
+ <li>A</li>
+ <p>B</p>
+ <li>C</li>
+</ul>
+<h1>D</h1>
+<p id="♥">E</p>
+<p id="☃">F</p>
+<div>G</div>
+EOF
+is($dom->at('li ~ p')->text, 'B', 'right text');
+is($dom->at('li + p')->text, 'B', 'right text');
+is($dom->at('h1 ~ p ~ p')->text, 'F', 'right text');
+is($dom->at('h1 + p ~ p')->text, 'F', 'right text');
+is($dom->at('h1 ~ p + p')->text, 'F', 'right text');
+is($dom->at('h1 + p + p')->text, 'F', 'right text');
+is($dom->at('ul > li ~ li')->text, 'C', 'right text');
+is($dom->at('ul li ~ li')->text, 'C', 'right text');
+is($dom->at('ul li li'), undef, 'no result');
+is($dom->at('ul ~ li ~ li'), undef, 'no result');
+is($dom->at('ul + li ~ li'), undef, 'no result');
+is($dom->at('ul > li + li'), undef, 'no result');
+is($dom->at('h1 ~ div')->text, 'G', 'right text');
+is($dom->at('h1 + div'), undef, 'no result');
+is($dom->at('p + div')->text, 'G', 'right text');
+is($dom->at('ul + h1 + p + p + div')->text, 'G', 'right text');
+is($dom->at('ul + h1 ~ p + div')->text, 'G', 'right text');
+is($dom->at('h1 ~ #♥')->text, 'E', 'right text');
+is($dom->at('h1 + #♥')->text, 'E', 'right text');
+is($dom->at('#♥ ~ #☃')->text, 'F', 'right text');
+is($dom->at('#♥ + #☃')->text, 'F', 'right text');
+is($dom->at('#♥ > #☃'), undef, 'no result');
+is($dom->at('#♥ #☃'), undef, 'no result');
+is($dom->at('#♥ + #☃ + :nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ ~ #☃ + :nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ + #☃ ~ :nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ ~ #☃ ~ :nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ + :nth-last-child(2)')->text, 'F', 'right text');
+is($dom->at('#♥ ~ :nth-last-child(2)')->text, 'F', 'right text');
+is($dom->at('#♥ + #☃ + *:nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ ~ #☃ + *:nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ + #☃ ~ *:nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ ~ #☃ ~ *:nth-last-child(1)')->text, 'G', 'right text');
+is($dom->at('#♥ + *:nth-last-child(2)')->text, 'F', 'right text');
+is($dom->at('#♥ ~ *:nth-last-child(2)')->text, 'F', 'right text');
+
+# Adding nodes
+$dom->parse(<<EOF);
+<ul>
+ <li>A</li>
+ <p>B</p>
+ <li>C</li>
+</ul>
+<div>D</div>
+EOF
+$dom->at('li')->after('<p>A1</p>23');
+is "$dom", <<EOF, 'right result';
+<ul>
+ <li>A</li><p>A1</p>23
+ <p>B</p>
+ <li>C</li>
+</ul>
+<div>D</div>
+EOF
+$dom->at('li')->before('24')->before('<div>A-1</div>25');
+is "$dom", <<EOF, 'right result';
+<ul>
+ 24<div>A-1</div>25<li>A</li><p>A1</p>23
+ <p>B</p>
+ <li>C</li>
+</ul>
+<div>D</div>
+EOF
+is $dom->at('div')->text, 'A-1', 'right text';
+$dom->before('l')->before('alal')->before('a');
+is "$dom", <<EOF, 'no change';
+<ul>
+ 24<div>A-1</div>25<li>A</li><p>A1</p>23
+ <p>B</p>
+ <li>C</li>
+</ul>
+<div>D</div>
+EOF
+$dom->after('lalala');
+is "$dom", <<EOF, 'no change';
+<ul>
+ 24<div>A-1</div>25<li>A</li><p>A1</p>23
+ <p>B</p>
+ <li>C</li>
+</ul>
+<div>D</div>
+EOF
+$dom->find('div')->each(sub { shift->after('works') });
+is "$dom", <<EOF, 'right result';
+<ul>
+ 24<div>A-1</div>works25<li>A</li><p>A1</p>23
+ <p>B</p>
+ <li>C</li>
+</ul>
+<div>D</div>works
+EOF
@@ -5,7 +5,5 @@ use warnings;
use Test::More tests => 1;
-use Test::Mojo::Server;
-
# I've gone back in time to when dinosaurs weren't just confined to zoos.
use_ok('Mojo::Server::FastCGI');
@@ -9,117 +9,97 @@ use Test::More tests => 37;
# So, have a merry Christmas, a happy Hanukkah, a kwaazy Kwanza,
# a tip-top Tet, and a solemn, dignified, Ramadan.
# And now a word from MY god, our sponsors!
-use_ok('Mojo::Headers');
+use_ok 'Mojo::Headers';
# Basic functionality
my $headers = Mojo::Headers->new;
$headers->add('Connection', 'close');
$headers->add('Connection', 'keep-alive');
-is($headers->header('Connection'), 'close, keep-alive', 'right value');
+is $headers->header('Connection'), 'close, keep-alive', 'right value';
$headers->remove('Connection');
-is($headers->header('Connection'), undef, 'no value');
+is $headers->header('Connection'), undef, 'no value';
$headers->content_type('text/html');
$headers->content_type('text/html');
$headers->expect('continue-100');
$headers->connection('close');
-is($headers->content_type, 'text/html', 'right value');
-like("$headers", qr/.*\x0d\x0a.*\x0d\x0a.*/, 'right format');
+is $headers->content_type, 'text/html', 'right value';
+like "$headers", qr/.*\x0d\x0a.*\x0d\x0a.*/, 'right format';
my $hash = $headers->to_hash;
-is($hash->{Connection}, 'close', 'right value');
-is($hash->{Expect}, 'continue-100', 'right value');
-is($hash->{'Content-Type'}, 'text/html', 'right value');
+is $hash->{Connection}, 'close', 'right value';
+is $hash->{Expect}, 'continue-100', 'right value';
+is $hash->{'Content-Type'}, 'text/html', 'right value';
$hash = $headers->to_hash(arrayref => 1);
-is_deeply($hash->{Connection}, [['close']], 'right structure');
-is_deeply($hash->{Expect}, [['continue-100']], 'right structure');
-is_deeply($hash->{'Content-Type'}, [['text/html']], 'right structure');
-is_deeply(
- [sort @{$headers->names}],
- [qw/Connection Content-Type Expect/],
- 'right structure'
-);
+is_deeply $hash->{Connection}, [['close']], 'right structure';
+is_deeply $hash->{Expect}, [['continue-100']], 'right structure';
+is_deeply $hash->{'Content-Type'}, [['text/html']], 'right structure';
+is_deeply [sort @{$headers->names}], [qw/Connection Content-Type Expect/],
+ 'right structure';
# Multiline values
$headers = Mojo::Headers->new;
$headers->header('X-Test', [23, 24], 'single line', [25, 26]);
-is( "$headers",
+is "$headers",
"X-Test: 23\x0d\x0a 24\x0d\x0a"
- . "X-Test: single line\x0d\x0a"
- . "X-Test: 25\x0d\x0a 26",
- 'right format'
-);
+ . "X-Test: single line\x0d\x0a"
+ . "X-Test: 25\x0d\x0a 26", 'right format';
my @array = $headers->header('X-Test');
-is_deeply(\@array, [[23, 24], ['single line'], [25, 26]], 'right structure');
-is_deeply(
- $headers->to_hash(arrayref => 1),
- {'X-Test' => [[23, 24], ['single line'], [25, 26]]},
- 'right structure'
-);
-is_deeply(
- $headers->to_hash,
- {'X-Test' => [[23, 24], 'single line', [25, 26]]},
- 'right structure'
-);
+is_deeply \@array, [[23, 24], ['single line'], [25, 26]], 'right structure';
+is_deeply $headers->to_hash(arrayref => 1),
+ {'X-Test' => [[23, 24], ['single line'], [25, 26]]}, 'right structure';
+is_deeply $headers->to_hash,
+ {'X-Test' => [[23, 24], 'single line', [25, 26]]}, 'right structure';
my $string = $headers->header('X-Test');
-is($string, "23, 24, single line, 25, 26", 'right format');
+is $string, "23, 24, single line, 25, 26", 'right format';
# Parse headers
$headers = Mojo::Headers->new;
-is(ref $headers->parse(<<'EOF'), 'Mojo::ByteStream', 'right return value');
+is ref $headers->parse(<<'EOF'), 'Mojo::ByteStream', 'right return value';
Content-Type: text/plain
Expect: 100-continue
EOF
-ok($headers->is_done, 'parser is done');
-is($headers->content_type, 'text/plain', 'right value');
-is($headers->expect, '100-continue', 'right value');
+ok $headers->is_done, 'parser is done';
+is $headers->content_type, 'text/plain', 'right value';
+is $headers->expect, '100-continue', 'right value';
# Set headers from hash
$headers = Mojo::Headers->new;
$headers->from_hash({Connection => 'close', 'Content-Type' => 'text/html'});
-is_deeply(
- $headers->to_hash,
- {Connection => 'close', 'Content-Type' => 'text/html'},
- 'right structure'
-);
+is_deeply $headers->to_hash,
+ {Connection => 'close', 'Content-Type' => 'text/html'}, 'right structure';
# Remove all headers
$headers->from_hash({});
-is_deeply($headers->to_hash, {}, 'right structure');
+is_deeply $headers->to_hash, {}, 'right structure';
$headers = Mojo::Headers->new;
$headers->from_hash(
{'X-Test' => [[23, 24], ['single line'], [25, 26]], 'X-Test2' => 'foo'});
$hash = $headers->to_hash;
-is_deeply(
- $hash->{'X-Test'},
- [[23, 24], 'single line', [25, 26]],
- 'right structure'
-);
-is_deeply($hash->{'X-Test2'}, 'foo', 'right structure');
+is_deeply $hash->{'X-Test'}, [[23, 24], 'single line', [25, 26]],
+ 'right structure';
+is_deeply $hash->{'X-Test2'}, 'foo', 'right structure';
$hash = $headers->to_hash(arrayref => 1);
-is_deeply(
- $hash->{'X-Test'},
- [[23, 24], ['single line'], [25, 26]],
- 'right structure'
-);
-is_deeply($hash->{'X-Test2'}, [['foo']], 'right structure');
+is_deeply $hash->{'X-Test'}, [[23, 24], ['single line'], [25, 26]],
+ 'right structure';
+is_deeply $hash->{'X-Test2'}, [['foo']], 'right structure';
# Headers in chunks
$headers = Mojo::Headers->new;
-ok(!defined($headers->parse(<<EOF)), 'right return value');
+ok !defined($headers->parse(<<EOF)), 'right return value';
Content-Type: text/plain
EOF
-ok(!$headers->is_done, 'parser is not done');
-ok(!defined($headers->content_type), 'no value');
-ok(!defined($headers->parse(<<EOF)), 'right return value');
+ok !$headers->is_done, 'parser is not done';
+ok !defined($headers->content_type), 'no value';
+ok !defined($headers->parse(<<EOF)), 'right return value';
X-Bender: Bite my shiny
EOF
-ok(!$headers->is_done, 'parser is not done');
-ok(!defined($headers->connection), 'no value');
-is(ref $headers->parse(<<EOF), 'Mojo::ByteStream', 'right return value');
+ok !$headers->is_done, 'parser is not done';
+ok !defined($headers->connection), 'no value';
+is ref $headers->parse(<<EOF), 'Mojo::ByteStream', 'right return value';
X-Bender: metal ass!
EOF
-ok($headers->is_done, 'parser is done');
-is($headers->content_type, 'text/plain', 'right value');
-is($headers->header('X-Bender'), 'Bite my shiny, metal ass!', 'right value');
+ok $headers->is_done, 'parser is done';
+is $headers->content_type, 'text/plain', 'right value';
+is $headers->header('X-Bender'), 'Bite my shiny, metal ass!', 'right value';
@@ -10,18 +10,18 @@ use File::Spec;
use FindBin;
# Uh, no, you got the wrong number. This is 9-1... 2
-use_ok('Mojo::Home');
+use_ok 'Mojo::Home';
# detect env
my $backup = $ENV{MOJO_HOME} || '';
my $path = File::Spec->catdir(qw/foo bar baz/);
$ENV{MOJO_HOME} = $path;
my $home = Mojo::Home->new->detect;
-is($home->to_string, $path, 'right path detected');
+is $home->to_string, $path, 'right path detected';
$ENV{MOJO_HOME} = $backup;
# detect directory
my $original =
File::Spec->catdir(File::Spec->splitdir($FindBin::Bin), '..', '..');
$home = Mojo::Home->new->detect;
-is(Cwd::realpath($original), Cwd::realpath("$home"), 'right path detected');
+is Cwd::realpath($original), Cwd::realpath("$home"), 'right path detected';
@@ -5,7 +5,7 @@ use warnings;
use Test::More tests => 5;
-use_ok('Mojo::IOLoop');
+use_ok 'Mojo::IOLoop';
# Marge, you being a cop makes you the man!
# Which makes me the woman, and I have no interest in that,
@@ -15,7 +15,7 @@ my $loop = Mojo::IOLoop->new;
# Ticks
my $ticks = 0;
-$loop->tick_cb(sub { $ticks++ });
+$loop->on_tick(sub { $ticks++ });
# Timer
my $flag = 0;
@@ -41,20 +41,20 @@ $loop->timer(0.25 => sub { $hiresflag = 42 });
$loop->start;
# Timer
-is($flag, 23, 'recursive timer works');
+is $flag, 23, 'recursive timer works';
# HiRes timer
-is($hiresflag, 42, 'hires timer');
+is $hiresflag, 42, 'hires timer';
# Idle callback
my $idle = 0;
-$loop->idle_cb(sub { $idle++ });
+$loop->on_idle(sub { $idle++ });
# Another tick
$loop->one_tick;
# Ticks
-ok($ticks > 2, 'more than two ticks');
+ok $ticks > 2, 'more than two ticks';
# Idle callback
-is($idle, 1, 'idle_cb was called');
+is $idle, 1, 'on_idle was called';
@@ -8,76 +8,73 @@ use Test::More tests => 97;
use Mojo::ByteStream 'b';
# We should be safe up here. I'm pretty sure fires can't climb trees.
-use_ok('Mojo::JSON');
+use_ok 'Mojo::JSON';
my $json = Mojo::JSON->new;
# Decode array
my $array = $json->decode('[]');
-is_deeply($array, [], 'decode []');
+is_deeply $array, [], 'decode []';
$array = $json->decode('[ [ ]]');
-is_deeply($array, [[]], 'decode [ [ ]]');
+is_deeply $array, [[]], 'decode [ [ ]]';
# Decode number
$array = $json->decode('[0]');
-is_deeply($array, [0], 'decode [0]');
+is_deeply $array, [0], 'decode [0]';
$array = $json->decode('[1]');
-is_deeply($array, [1], 'decode [1]');
+is_deeply $array, [1], 'decode [1]';
$array = $json->decode('[ -122.026020 ]');
-is_deeply($array, ['-122.026020'], 'decode [ -122.026020 ]');
+is_deeply $array, ['-122.026020'], 'decode [ -122.026020 ]';
$array = $json->decode('[0.0]');
-isa_ok($array, 'ARRAY', 'decode [0.0]');
-cmp_ok($array->[0], '==', 0, 'value is 0');
+isa_ok $array, 'ARRAY', 'decode [0.0]';
+cmp_ok $array->[0], '==', 0, 'value is 0';
$array = $json->decode('[0e0]');
-isa_ok($array, 'ARRAY', 'decode [0e0]');
-cmp_ok($array->[0], '==', 0, 'value is 0');
+isa_ok $array, 'ARRAY', 'decode [0e0]';
+cmp_ok $array->[0], '==', 0, 'value is 0';
$array = $json->decode('[1,-2]');
-is_deeply($array, [1, -2], 'decode [1,-2]');
+is_deeply $array, [1, -2], 'decode [1,-2]';
$array = $json->decode('[10e12 , [2 ]]');
-is_deeply($array, ['10e12', [2]], 'decode [10e12 , [2 ]]');
+is_deeply $array, ['10e12', [2]], 'decode [10e12 , [2 ]]';
$array = $json->decode('[37.7668 , [ 20 ]] ');
-is_deeply($array, [37.7668, [20]], 'decode [37.7668 , [ 20 ]] ');
+is_deeply $array, [37.7668, [20]], 'decode [37.7668 , [ 20 ]] ';
$array = $json->decode('[1e3]');
-isa_ok($array, 'ARRAY', 'decode [1e3]');
-cmp_ok($array->[0], '==', 1e3, 'value is 1e3');
+isa_ok $array, 'ARRAY', 'decode [1e3]';
+cmp_ok $array->[0], '==', 1e3, 'value is 1e3';
# Decode name
$array = $json->decode('[true]');
-is_deeply($array, [$json->true], 'decode [true]');
+is_deeply $array, [$json->true], 'decode [true]';
$array = $json->decode('[null]');
-is_deeply($array, [undef], 'decode [null]');
+is_deeply $array, [undef], 'decode [null]';
$array = $json->decode('[true, false]');
-is_deeply($array, [$json->true, $json->false], 'decode [true, false]');
+is_deeply $array, [$json->true, $json->false], 'decode [true, false]';
# Decode string
$array = $json->decode('[" "]');
-is_deeply($array, [' '], 'decode [" "]');
+is_deeply $array, [' '], 'decode [" "]';
$array = $json->decode('["hello world!"]');
-is_deeply($array, ['hello world!'], 'decode ["hello world!"]');
+is_deeply $array, ['hello world!'], 'decode ["hello world!"]';
$array = $json->decode('["hello\nworld!"]');
-is_deeply($array, ["hello\nworld!"], 'decode ["hello\nworld!"]');
+is_deeply $array, ["hello\nworld!"], 'decode ["hello\nworld!"]';
$array = $json->decode('["hello\t\"world!"]');
-is_deeply($array, ["hello\t\"world!"], 'decode ["hello\t\"world!"]');
+is_deeply $array, ["hello\t\"world!"], 'decode ["hello\t\"world!"]';
$array = $json->decode('["hello\u0152world\u0152!"]');
-is_deeply(
- $array,
- ["hello\x{0152}world\x{0152}!"],
- 'decode ["hello\u0152world\u0152!"]'
-);
+is_deeply $array, ["hello\x{0152}world\x{0152}!"],
+ 'decode ["hello\u0152world\u0152!"]';
$array = $json->decode('["0."]');
-is_deeply($array, ['0.'], 'decode ["0."]');
+is_deeply $array, ['0.'], 'decode ["0."]';
$array = $json->decode('[" 0"]');
-is_deeply($array, [' 0'], 'decode [" 0"]');
+is_deeply $array, [' 0'], 'decode [" 0"]';
$array = $json->decode('["1"]');
-is_deeply($array, ['1'], 'decode ["1"]');
+is_deeply $array, ['1'], 'decode ["1"]';
# Decode object
my $hash = $json->decode('{}');
-is_deeply($hash, {}, 'decode {}');
+is_deeply $hash, {}, 'decode {}';
$hash = $json->decode('{"foo": "bar"}');
-is_deeply($hash, {foo => 'bar'}, 'decode {"foo": "bar"}');
+is_deeply $hash, {foo => 'bar'}, 'decode {"foo": "bar"}';
$hash = $json->decode('{"foo": [23, "bar"]}');
-is_deeply($hash, {foo => [qw/23 bar/]}, 'decode {"foo": [23, "bar"]}');
+is_deeply $hash, {foo => [qw/23 bar/]}, 'decode {"foo": [23, "bar"]}';
# Decode full spec example
$hash = $json->decode(<<EOF);
@@ -95,174 +92,165 @@ $hash = $json->decode(<<EOF);
}
}
EOF
-is($hash->{Image}->{Width}, 800, 'right value');
-is($hash->{Image}->{Height}, 600, 'right value');
-is($hash->{Image}->{Title}, 'View from 15th Floor', 'right value');
-is( $hash->{Image}->{Thumbnail}->{Url},
- 'http://www.example.com/image/481989943',
- 'right value'
-);
-is($hash->{Image}->{Thumbnail}->{Height}, 125, 'right value');
-is($hash->{Image}->{Thumbnail}->{Width}, 100, 'right value');
-is($hash->{Image}->{IDs}->[0], 116, 'right value');
-is($hash->{Image}->{IDs}->[1], 943, 'right value');
-is($hash->{Image}->{IDs}->[2], 234, 'right value');
-is($hash->{Image}->{IDs}->[3], 38793, 'right value');
+is $hash->{Image}->{Width}, 800, 'right value';
+is $hash->{Image}->{Height}, 600, 'right value';
+is $hash->{Image}->{Title}, 'View from 15th Floor', 'right value';
+is $hash->{Image}->{Thumbnail}->{Url},
+ 'http://www.example.com/image/481989943', 'right value';
+is $hash->{Image}->{Thumbnail}->{Height}, 125, 'right value';
+is $hash->{Image}->{Thumbnail}->{Width}, 100, 'right value';
+is $hash->{Image}->{IDs}->[0], 116, 'right value';
+is $hash->{Image}->{IDs}->[1], 943, 'right value';
+is $hash->{Image}->{IDs}->[2], 234, 'right value';
+is $hash->{Image}->{IDs}->[3], 38793, 'right value';
# Encode array
my $string = $json->encode([]);
-is($string, '[]', 'encode []');
+is $string, '[]', 'encode []';
$string = $json->encode([[]]);
-is($string, '[[]]', 'encode [[]]');
+is $string, '[[]]', 'encode [[]]';
$string = $json->encode([[], []]);
-is($string, '[[],[]]', 'encode [[], []]');
+is $string, '[[],[]]', 'encode [[], []]';
$string = $json->encode([[], [[]], []]);
-is($string, '[[],[[]],[]]', 'encode [[], [[]], []]');
+is $string, '[[],[[]],[]]', 'encode [[], [[]], []]';
# Encode string
$string = $json->encode(['foo']);
-is($string, '["foo"]', 'encode [\'foo\']');
+is $string, '["foo"]', 'encode [\'foo\']';
$string = $json->encode(["hello\nworld!"]);
-is($string, '["hello\nworld!"]', 'encode ["hello\nworld!"]');
+is $string, '["hello\nworld!"]', 'encode ["hello\nworld!"]';
$string = $json->encode(["hello\t\"world!"]);
-is($string, '["hello\t\"world!"]', 'encode ["hello\t\"world!"]');
+is $string, '["hello\t\"world!"]', 'encode ["hello\t\"world!"]';
$string = $json->encode(["hello\x{0003}\x{0152}world\x{0152}!"]);
-is( b($string)->decode('UTF-8'),
- "[\"hello\\u0003\x{0152}world\x{0152}!\"]",
- 'encode ["hello\x{0003}\x{0152}world\x{0152}!"]'
-);
+is b($string)->decode('UTF-8'), "[\"hello\\u0003\x{0152}world\x{0152}!\"]",
+ 'encode ["hello\x{0003}\x{0152}world\x{0152}!"]';
$string = $json->encode(["123abc"]);
-is($string, '["123abc"]', 'encode ["123abc"]');
+is $string, '["123abc"]', 'encode ["123abc"]';
# Encode object
$string = $json->encode({});
-is($string, '{}', 'encode {}');
+is $string, '{}', 'encode {}';
$string = $json->encode({foo => {}});
-is($string, '{"foo":{}}', 'encode {foo => {}}');
+is $string, '{"foo":{}}', 'encode {foo => {}}';
$string = $json->encode({foo => 'bar'});
-is($string, '{"foo":"bar"}', 'encode {foo => \'bar\'}');
+is $string, '{"foo":"bar"}', 'encode {foo => \'bar\'}';
$string = $json->encode({foo => []});
-is($string, '{"foo":[]}', 'encode {foo => []}');
+is $string, '{"foo":[]}', 'encode {foo => []}';
$string = $json->encode({foo => ['bar']});
-is($string, '{"foo":["bar"]}', 'encode {foo => [\'bar\']}');
+is $string, '{"foo":["bar"]}', 'encode {foo => [\'bar\']}';
# Encode name
$string = $json->encode([$json->true]);
-is($string, '[true]', 'encode [$json->true]');
+is $string, '[true]', 'encode [$json->true]';
$string = $json->encode([undef]);
-is($string, '[null]', 'encode [undef]');
+is $string, '[null]', 'encode [undef]';
$string = $json->encode([$json->true, $json->false]);
-is($string, '[true,false]', 'encode [$json->true, $json->false]');
+is $string, '[true,false]', 'encode [$json->true, $json->false]';
# Encode number
$string = $json->encode([1]);
-is($string, '[1]', 'encode [1]');
+is $string, '[1]', 'encode [1]';
$string = $json->encode(['-122.026020']);
-is($string, '[-122.026020]', 'encode [\'-122.026020\']');
+is $string, '[-122.026020]', 'encode [\'-122.026020\']';
$string = $json->encode([1, -2]);
-is($string, '[1,-2]', 'encode [1, -2]');
+is $string, '[1,-2]', 'encode [1, -2]';
$string = $json->encode(['10e12', [2]]);
-is($string, '[10e12,[2]]', 'encode [\'10e12\', [2]]');
+is $string, '[10e12,[2]]', 'encode [\'10e12\', [2]]';
$string = $json->encode([37.7668, [20]]);
-is($string, '[37.7668,[20]]', 'encode [37.7668, [20]]');
+is $string, '[37.7668,[20]]', 'encode [37.7668, [20]]';
# Faihu roundtrip
$string = $json->encode(["\x{10346}"]);
-is(b($string)->decode('UTF-8'), "[\"\x{10346}\"]", 'encode ["\x{10346}"]');
+is b($string)->decode('UTF-8'), "[\"\x{10346}\"]", 'encode ["\x{10346}"]';
$array = $json->decode($string);
-is_deeply($array, ["\x{10346}"], 'successful roundtrip');
+is_deeply $array, ["\x{10346}"], 'successful roundtrip';
# Decode UTF-16LE
$array = $json->decode(b("\x{feff}[true]")->encode('UTF-16LE'));
-is_deeply($array, [$json->true], 'decode \x{feff}[true]');
+is_deeply $array, [$json->true], 'decode \x{feff}[true]';
# Decode UTF-16LE with faihu surrogate pair
$array = $json->decode(b("\x{feff}[\"\\ud800\\udf46\"]")->encode('UTF-16LE'));
-is_deeply($array, ["\x{10346}"], 'decode \x{feff}[\"\\ud800\\udf46\"]');
+is_deeply $array, ["\x{10346}"], 'decode \x{feff}[\"\\ud800\\udf46\"]';
# Decode UTF-16LE with faihu surrogate pair and BOM value
$array = $json->decode(
b("\x{feff}[\"\\ud800\\udf46\x{feff}\"]")->encode('UTF-16LE'));
-is_deeply($array, ["\x{10346}\x{feff}"],
- 'decode \x{feff}[\"\\ud800\\udf46\x{feff}\"]');
+is_deeply $array, ["\x{10346}\x{feff}"],
+ 'decode \x{feff}[\"\\ud800\\udf46\x{feff}\"]';
# Decode UTF-16LE with missing high surrogate
$array = $json->decode(b("\x{feff}[\"\\ud800\"]")->encode('UTF-16LE'));
-is_deeply($array, ['\ud800'], 'decode \x{feff}[\"\\ud800\"]');
+is_deeply $array, ['\ud800'], 'decode \x{feff}[\"\\ud800\"]';
# Decode UTF-16LE with missing low surrogate
$array = $json->decode(b("\x{feff}[\"\\udf46\"]")->encode('UTF-16LE'));
-is_deeply($array, ['\udf46'], 'decode \x{feff}[\"\\udf46\"]');
+is_deeply $array, ['\udf46'], 'decode \x{feff}[\"\\udf46\"]';
# Decode UTF-16BE with faihu surrogate pair
$array = $json->decode(b("\x{feff}[\"\\ud800\\udf46\"]")->encode('UTF-16BE'));
-is_deeply($array, ["\x{10346}"], 'decode \x{feff}[\"\\ud800\\udf46\"]');
+is_deeply $array, ["\x{10346}"], 'decode \x{feff}[\"\\ud800\\udf46\"]';
# Decode UTF-32LE
$array = $json->decode(b("\x{feff}[true]")->encode('UTF-32LE'));
-is_deeply($array, [$json->true], 'decode \x{feff}[true]');
+is_deeply $array, [$json->true], 'decode \x{feff}[true]';
# Decode UTF-32BE
$array = $json->decode(b("\x{feff}[true]")->encode('UTF-32BE'));
-is_deeply($array, [$json->true], 'decode \x{feff}[true]');
+is_deeply $array, [$json->true], 'decode \x{feff}[true]';
# Decode UTF-16LE without BOM
$array = $json->decode(b("[\"\\ud800\\udf46\"]")->encode('UTF-16LE'));
-is_deeply($array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]');
+is_deeply $array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]';
# Decode UTF-16BE without BOM
$array = $json->decode(b("[\"\\ud800\\udf46\"]")->encode('UTF-16BE'));
-is_deeply($array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]');
+is_deeply $array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]';
# Decode UTF-32LE without BOM
$array = $json->decode(b("[\"\\ud800\\udf46\"]")->encode('UTF-32LE'));
-is_deeply($array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]');
+is_deeply $array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]';
# Decode UTF-32BE without BOM
$array = $json->decode(b("[\"\\ud800\\udf46\"]")->encode('UTF-32BE'));
-is_deeply($array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]');
+is_deeply $array, ["\x{10346}"], 'decode [\"\\ud800\\udf46\"]';
# Complicated roudtrips
$string = '[null,false,true,"",0,1]';
$array = $json->decode($string);
-isa_ok($array, 'ARRAY', 'decode [null,false,true,"",0,1]');
-is($json->encode($array), $string, 'reencode');
+isa_ok $array, 'ARRAY', 'decode [null,false,true,"",0,1]';
+is $json->encode($array), $string, 'reencode';
$array = [undef, 0, 1, '', $json->true, $json->false];
$string = $json->encode($array);
-ok($string, 'defined value');
-is_deeply($json->decode($string), $array, 'successful roundtrip');
+ok $string, 'defined value';
+is_deeply $json->decode($string), $array, 'successful roundtrip';
# Real world roundtrip
$string = $json->encode({foo => 'c:\progra~1\mozill~1\firefox.exe'});
-is( $string,
- '{"foo":"c:\\\\progra~1\\\\mozill~1\\\\firefox.exe"}',
- 'encode {foo => \'c:\progra~1\mozill~1\firefox.exe\'}'
-);
+is $string, '{"foo":"c:\\\\progra~1\\\\mozill~1\\\\firefox.exe"}',
+ 'encode {foo => \'c:\progra~1\mozill~1\firefox.exe\'}';
$hash = $json->decode($string);
-is_deeply(
- $hash,
- {foo => 'c:\progra~1\mozill~1\firefox.exe'},
- 'successful roundtrip'
-);
+is_deeply $hash, {foo => 'c:\progra~1\mozill~1\firefox.exe'},
+ 'successful roundtrip';
# Errors
-is($json->decode('[[]'), undef, 'missing right square bracket');
-is($json->error, 'Missing right square bracket near end of file.',
- 'right error');
-is($json->decode('{{}'), undef, 'missing right curly bracket');
-is($json->error, 'Missing right curly bracket near end of file.',
- 'right error');
-is($json->decode('[[]...'), undef, 'syntax error');
-is($json->error, 'Syntax error near "...".', 'right error');
-is($json->decode('{{}...'), undef, 'syntax error');
-is($json->error, 'Syntax error near "...".', 'right error');
-is($json->decode('[nan]'), undef, 'syntax error');
-is($json->error, 'Syntax error near "nan]".', 'right error');
-is($json->decode('["foo]'), undef, 'syntax error');
-is($json->error, 'Syntax error near ""foo]".', 'right error');
-is($json->decode('false'), undef, 'no object or array');
-is($json->error, 'JSON text has to be a serialized object or array.',
- 'right error');
-is($json->decode(''), undef, 'no object or array');
-is($json->error, 'JSON text has to be a serialized object or array.',
- 'right error');
+is $json->decode('[[]'), undef, 'missing right square bracket';
+is $json->error, 'Missing right square bracket near end of file.',
+ 'right error';
+is $json->decode('{{}'), undef, 'missing right curly bracket';
+is $json->error, 'Missing right curly bracket near end of file.',
+ 'right error';
+is $json->decode('[[]...'), undef, 'syntax error';
+is $json->error, 'Syntax error near "...".', 'right error';
+is $json->decode('{{}...'), undef, 'syntax error';
+is $json->error, 'Syntax error near "...".', 'right error';
+is $json->decode('[nan]'), undef, 'syntax error';
+is $json->error, 'Syntax error near "nan]".', 'right error';
+is $json->decode('["foo]'), undef, 'syntax error';
+is $json->error, 'Syntax error near ""foo]".', 'right error';
+is $json->decode('false'), undef, 'no object or array';
+is $json->error, 'JSON text has to be a serialized object or array.',
+ 'right error';
+is $json->decode(''), undef, 'no object or array';
+is $json->error, 'JSON text has to be a serialized object or array.',
+ 'right error';
@@ -14,57 +14,54 @@ use IO::File;
# Bad bees. Get away from my sugar.
# Ow. OW. Oh, they're defending themselves somehow.
-use_ok('Mojo::Loader');
+use_ok 'Mojo::Loader';
# Exception
my $loader = Mojo::Loader->new;
my $e = $loader->load('LoaderException');
-is(ref $e, 'Mojo::Exception', 'right object');
-like($e->message, qr/Missing right curly/, 'right message');
-is($e->lines_before->[0]->[0], 11, 'right line');
-is($e->lines_before->[0]->[1], 'foo {', 'right value');
-is($e->lines_before->[1]->[0], 12, 'right line');
-is($e->lines_before->[1]->[1], '', 'right value');
-is($e->line->[0], 13, 'right line');
-is($e->line->[1], "1;", 'right value');
-like("$e", qr/Missing right curly/, 'right message');
+is ref $e, 'Mojo::Exception', 'right object';
+like $e->message, qr/Missing right curly/, 'right message';
+is $e->lines_before->[0]->[0], 11, 'right line';
+is $e->lines_before->[0]->[1], 'foo {', 'right value';
+is $e->lines_before->[1]->[0], 12, 'right line';
+is $e->lines_before->[1]->[1], '', 'right value';
+is $e->line->[0], 13, 'right line';
+is $e->line->[1], "1;", 'right value';
+like "$e", qr/Missing right curly/, 'right message';
# Complicated exception
$loader = Mojo::Loader->new;
$e = $loader->load('LoaderException2');
-is(ref $e, 'Mojo::Exception', 'right object');
-like($e->message, qr/Exception/, 'right message');
-is($e->lines_before->[0]->[0], 4, 'right line');
-is($e->lines_before->[0]->[1], 'use strict;', 'right value');
-is($e->lines_before->[1]->[0], 5, 'right line');
-is($e->lines_before->[1]->[1], '', 'right value');
-is($e->line->[0], 6, 'right line');
-is($e->line->[1], 'LoaderException2_2::throw_error();', 'right value');
-is($e->lines_after->[0]->[0], 7, 'right line');
-is($e->lines_after->[0]->[1], '', 'right value');
-is($e->lines_after->[1]->[0], 8, 'right line');
-is($e->lines_after->[1]->[1], '1;', 'right value');
-like("$e", qr/Exception/, 'right message');
+is ref $e, 'Mojo::Exception', 'right object';
+like $e->message, qr/Exception/, 'right message';
+is $e->lines_before->[0]->[0], 4, 'right line';
+is $e->lines_before->[0]->[1], 'use strict;', 'right value';
+is $e->lines_before->[1]->[0], 5, 'right line';
+is $e->lines_before->[1]->[1], '', 'right value';
+is $e->line->[0], 6, 'right line';
+is $e->line->[1], 'LoaderException2_2::throw_error();', 'right value';
+is $e->lines_after->[0]->[0], 7, 'right line';
+is $e->lines_after->[0]->[1], '', 'right value';
+is $e->lines_after->[1]->[0], 8, 'right line';
+is $e->lines_after->[1]->[1], '1;', 'right value';
+like "$e", qr/Exception/, 'right message';
$loader = Mojo::Loader->new;
my $modules = $loader->search('LoaderTest');
my @modules = sort @$modules;
# Search
-is_deeply(
- \@modules,
- [qw/LoaderTest::A LoaderTest::B LoaderTest::C/],
- 'found the right modules'
-);
+is_deeply \@modules, [qw/LoaderTest::A LoaderTest::B LoaderTest::C/],
+ 'found the right modules';
# Load
$loader->load($_) for @modules;
-ok(LoaderTest::A->can('new'), 'loaded successfully');
-ok(LoaderTest::B->can('new'), 'loaded successfully');
-ok(LoaderTest::C->can('new'), 'loaded successfully');
+ok LoaderTest::A->can('new'), 'loaded successfully';
+ok LoaderTest::B->can('new'), 'loaded successfully';
+ok LoaderTest::C->can('new'), 'loaded successfully';
# Load unrelated class
-ok($loader->load('LoaderTest'), 'loaded successfully');
+ok $loader->load('LoaderTest'), 'loaded successfully';
# Reload
my $file = IO::File->new;
@@ -75,10 +72,10 @@ $file->syswrite("package MojoTestReloader;\nsub test { 23 }\n1;");
$file->close;
push @INC, $dir;
require MojoTestReloader;
-is(MojoTestReloader::test(), 23, 'loaded successfully');
+is MojoTestReloader::test(), 23, 'loaded successfully';
sleep 2;
$file->open("> $path");
$file->syswrite("package MojoTestReloader;\nsub test { 26 }\n1;");
$file->close;
Mojo::Loader->reload;
-is(MojoTestReloader::test(), 26, 'reloaded successfully');
+is MojoTestReloader::test(), 26, 'reloaded successfully';
@@ -5,25 +5,24 @@ use warnings;
use utf8;
-use Test::More tests => 801;
+use Test::More tests => 858;
use File::Spec;
use File::Temp;
-use Mojo::Filter::Chunked;
use Mojo::Headers;
# When will I learn?
# The answer to life's problems aren't at the bottom of a bottle,
# they're on TV!
-use_ok('Mojo::Asset::File');
-use_ok('Mojo::Content::Single');
-use_ok('Mojo::Content::MultiPart');
-use_ok('Mojo::Cookie::Request');
-use_ok('Mojo::Cookie::Response');
-use_ok('Mojo::Headers');
-use_ok('Mojo::Message');
-use_ok('Mojo::Message::Request');
-use_ok('Mojo::Message::Response');
+use_ok 'Mojo::Asset::File';
+use_ok 'Mojo::Content::Single';
+use_ok 'Mojo::Content::MultiPart';
+use_ok 'Mojo::Cookie::Request';
+use_ok 'Mojo::Cookie::Response';
+use_ok 'Mojo::Headers';
+use_ok 'Mojo::Message';
+use_ok 'Mojo::Message::Request';
+use_ok 'Mojo::Message::Response';
# Pollution
123 =~ m/(\d+)/;
@@ -31,30 +30,28 @@ use_ok('Mojo::Message::Response');
# Parse HTTP 1.1 start line, no headers and body
my $req = Mojo::Message::Request->new;
$req->parse("GET / HTTP/1.1\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/', 'right URL');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/', 'right URL';
# Parse pipelined HTTP 1.1 start line, no headers and body
$req = Mojo::Message::Request->new;
$req->parse("GET / HTTP/1.1\x0d\x0a\x0d\x0aGET / HTTP/1.1\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is( $req->leftovers,
- "GET / HTTP/1.1\x0d\x0a\x0d\x0a",
- 'second request in leftovers'
-);
+ok $req->is_done, 'request is done';
+is $req->leftovers, "GET / HTTP/1.1\x0d\x0a\x0d\x0a",
+ 'second request in leftovers';
# Parse HTTP 1.1 start line, no headers and body with leading CRLFs
# (SHOULD be ignored, RFC2616, Section 4.1)
$req = Mojo::Message::Request->new;
$req->parse("\x0d\x0aGET / HTTP/1.1\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/', 'right URL');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/', 'right URL';
# Parse WebSocket handshake request
$req = Mojo::Message::Request->new;
@@ -69,46 +66,67 @@ $req->parse("Origin: http://example.com\x0d\x0a\x0d\x0a");
$req->parse('^');
$req->parse('n:ds');
$req->parse('[4U');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/demo', 'right URL');
-is($req->headers->host, 'example.com', 'right "Host" value');
-is($req->headers->connection, 'Upgrade', 'right "Connection" value');
-is( $req->headers->sec_websocket_key2,
- '12998 5 Y3 1 .P00',
- 'right "Sec-WebSocket-Key2" value'
-);
-is($req->headers->sec_websocket_protocol,
- 'sample', 'right "Sec-WebSocket-Protocol" value');
-is($req->headers->upgrade, 'WebSocket', 'right "Upgrade" value');
-is( $req->headers->sec_websocket_key1,
- '4 @1 46546xW%0l 1 5',
- 'right "Sec-WebSocket-Key1" value'
-);
-is($req->headers->origin, 'http://example.com', 'right "Origin" value');
-is($req->body, '^n:ds[4U', 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/demo', 'right URL';
+is $req->headers->host, 'example.com', 'right "Host" value';
+is $req->headers->connection, 'Upgrade', 'right "Connection" value';
+is $req->headers->sec_websocket_key2, '12998 5 Y3 1 .P00',
+ 'right "Sec-WebSocket-Key2" value';
+is $req->headers->sec_websocket_protocol, 'sample',
+ 'right "Sec-WebSocket-Protocol" value';
+is $req->headers->upgrade, 'WebSocket', 'right "Upgrade" value';
+is $req->headers->sec_websocket_key1, '4 @1 46546xW%0l 1 5',
+ 'right "Sec-WebSocket-Key1" value';
+is $req->headers->origin, 'http://example.com', 'right "Origin" value';
+is $req->body, '^n:ds[4U', 'right content';
# Parse HTTP 1.0 start line and headers, no body
$req = Mojo::Message::Request->new;
$req->parse("GET /foo/bar/baz.html HTTP/1.0\x0d\x0a");
$req->parse("Content-Type: text/plain\x0d\x0a");
$req->parse("Content-Length: 0\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/foo/bar/baz.html', 'right URL');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->content_length, 0, 'right "Content-Length" value');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html', 'right URL';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->content_length, 0, 'right "Content-Length" value';
+
+# Parse HTTP 1.0 start line and headers, no body (missing Content-Length)
+$req = Mojo::Message::Request->new;
+$req->parse("GET /foo/bar/baz.html HTTP/1.0\x0d\x0a");
+$req->parse("Content-Type: text/plain\x0d\x0a\x0d\x0a");
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html', 'right URL';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->content_length, undef, 'no "Content-Length" value';
+
+# Parse HTTP 1.0 start line and headers, no body (missing Content-Length)
+$req = Mojo::Message::Request->new;
+$req->parse("GET /foo/bar/baz.html HTTP/1.0\x0d\x0a");
+$req->parse("Content-Type: text/plain\x0d\x0a");
+$req->parse("Connection: Close\x0d\x0a\x0d\x0a");
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html', 'right URL';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->content_length, undef, 'no "Content-Length" value';
# Parse HTTP 1.0 start line and headers, no body (with line size limit)
$req = Mojo::Message::Request->new;
my $backup = $ENV{MOJO_MAX_LINE_SIZE} || '';
$ENV{MOJO_MAX_LINE_SIZE} = 5;
$req->parse('GET /foo/bar/baz.html HTTP/1');
-ok($req->is_done, 'request is done');
+ok $req->is_done, 'request is done';
is(($req->error)[1], 413, 'right status');
$ENV{MOJO_MAX_LINE_SIZE} = $backup;
@@ -117,7 +135,7 @@ $req = Mojo::Message::Request->new;
$backup = $ENV{MOJO_MAX_MESSAGE_SIZE} || '';
$ENV{MOJO_MAX_MESSAGE_SIZE} = 5;
$req->parse('GET /foo/bar/baz.html HTTP/1');
-ok($req->is_done, 'request is done');
+ok $req->is_done, 'request is done';
is(($req->error)[1], 413, 'right status');
$ENV{MOJO_MAX_MESSAGE_SIZE} = $backup;
@@ -128,13 +146,13 @@ $req->parse("o=13#23 HTTP/1.0\x0d\x0aContent");
$req->parse('-Type: text/');
$req->parse("plain\x0d\x0aContent-Length: 27\x0d\x0a\x0d\x0aHell");
$req->parse("o World!\n1234\nlalalala\n");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->content_length, 27, 'right "Content-Length" value');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->content_length, 27, 'right "Content-Length" value';
# Parse full HTTP 1.0 request (behind reverse proxy)
$req = Mojo::Message::Request->new;
@@ -145,22 +163,20 @@ $req->parse("plain\x0d\x0aContent-Length: 27\x0d\x0a");
$req->parse("Host: mojolicious.org\x0d\x0a");
$req->parse("X-Forwarded-For: 192.168.2.1, 127.0.0.1\x0d\x0a\x0d\x0a");
$req->parse("Hello World!\n1234\nlalalala\n");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is( $req->url->to_abs,
- 'http://mojolicious.org/foo/bar/baz.html?foo=13#23',
- 'right absolute URL'
-);
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->content_length, 27, 'right "Content-Length" value');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->url->to_abs, 'http://mojolicious.org/foo/bar/baz.html?foo=13#23',
+ 'right absolute URL';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->content_length, 27, 'right "Content-Length" value';
# Parse full HTTP 1.0 request with zero chunk
$req = Mojo::Message::Request->new;
my $finished;
-$req->finish_cb(sub { $finished = shift->is_done });
+$req->on_finish(sub { $finished = shift->is_done });
$req->parse('GET /foo/bar/baz.html?fo');
$req->parse("o=13#23 HTTP/1.0\x0d\x0aContent");
$req->parse('-Type: text/');
@@ -168,14 +184,14 @@ $req->parse("plain\x0d\x0aContent-Length: 27\x0d\x0a\x0d\x0aHell");
$req->parse("o World!\n123");
$req->parse('0');
$req->parse("\nlalalala\n");
-ok($finished, 'finish callback was called');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->content_length, 27, 'right "Content-Length" value');
+ok $finished, 'finish callback was called';
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->content_length, 27, 'right "Content-Length" value';
# Parse full HTTP 1.0 request with utf8 form input
$req = Mojo::Message::Request->new;
@@ -185,26 +201,24 @@ $req->parse('-Type: application/');
$req->parse("x-www-form-urlencoded\x0d\x0aContent-Length: 53");
$req->parse("\x0d\x0a\x0d\x0a");
$req->parse('name=%D0%92%D1%8F%D1%87%D0%B5%D1%81%D0%BB%D0%B0%D0%B2');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is( $req->headers->content_type,
- 'application/x-www-form-urlencoded',
- 'right "Content-Type" value'
-);
-is($req->headers->content_length, 53, 'right "Content-Length" value');
-is($req->param('name'), 'Вячеслав', 'right value');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_type, 'application/x-www-form-urlencoded',
+ 'right "Content-Type" value';
+is $req->headers->content_length, 53, 'right "Content-Length" value';
+is $req->param('name'), 'Вячеслав', 'right value';
# Parse HTTP 0.9 request
$req = Mojo::Message::Request->new;
$req->parse("GET /\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 0, 'right major version');
-is($req->minor_version, 9, 'right minor version');
-is($req->url, '/', 'right URL');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 0, 'right major version';
+is $req->minor_version, 9, 'right minor version';
+is $req->url, '/', 'right URL';
# Parse HTTP 1.1 chunked request
$req = Mojo::Message::Request->new;
@@ -216,20 +230,20 @@ $req->parse("abcd\x0d\x0a");
$req->parse("9\x0d\x0a");
$req->parse("abcdefghi\x0d\x0a");
$req->parse("0\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is($req->headers->content_length, 13, 'right "Content-Length" value');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->content->asset->size, 13, 'right size');
-is($req->content->asset->slurp, 'abcdabcdefghi', 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_length, 13, 'right "Content-Length" value';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->content->asset->size, 13, 'right size';
+is $req->content->asset->slurp, 'abcdabcdefghi', 'right content';
# Parse HTTP 1.1 chunked request with callback
$req = Mojo::Message::Request->new;
my $buffer = '';
-$req->body_cb(sub { $buffer .= pop });
+$req->on_read(sub { $buffer .= pop });
$req->parse("POST /foo/bar/baz.html?foo=13#23 HTTP/1.1\x0d\x0a");
$req->parse("Content-Type: text/plain\x0d\x0a");
$req->parse("Transfer-Encoding: chunked\x0d\x0a\x0d\x0a");
@@ -238,14 +252,14 @@ $req->parse("abcd\x0d\x0a");
$req->parse("9\x0d\x0a");
$req->parse("abcdefghi\x0d\x0a");
$req->parse("0\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is($req->headers->content_length, 13, 'right "Content-Length" value');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($buffer, 'abcdabcdefghi', 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_length, 13, 'right "Content-Length" value';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $buffer, 'abcdabcdefghi', 'right content';
# Parse HTTP 1.1 "x-application-urlencoded"
$req = Mojo::Message::Request->new;
@@ -253,20 +267,19 @@ $req->parse("POST /foo/bar/baz.html?foo=13#23 HTTP/1.1\x0d\x0a");
$req->parse("Content-Length: 26\x0d\x0a");
$req->parse("Content-Type: x-application-urlencoded\x0d\x0a\x0d\x0a");
$req->parse('foo=bar& tset=23+;&foo=bar');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is($req->headers->content_type,
- 'x-application-urlencoded', 'right "Content-Type" value');
-is($req->content->asset->size, 26, 'right size');
-is($req->content->asset->slurp, 'foo=bar& tset=23+;&foo=bar',
- 'right content');
-is($req->body_params, 'foo=bar&+tset=23+&foo=bar', 'right parameters');
-is_deeply($req->body_params->to_hash->{foo}, [qw/bar bar/], 'right values');
-is_deeply($req->body_params->to_hash->{' tset'}, '23 ', 'right value');
-is_deeply($req->params->to_hash->{foo}, [qw/bar bar 13/], 'right values');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_type,
+ 'x-application-urlencoded', 'right "Content-Type" value';
+is $req->content->asset->size, 26, 'right size';
+is $req->content->asset->slurp, 'foo=bar& tset=23+;&foo=bar', 'right content';
+is $req->body_params, 'foo=bar&+tset=23+&foo=bar', 'right parameters';
+is_deeply $req->body_params->to_hash->{foo}, [qw/bar bar/], 'right values';
+is_deeply $req->body_params->to_hash->{' tset'}, '23 ', 'right value';
+is_deeply $req->params->to_hash->{foo}, [qw/bar bar 13/], 'right values';
# Parse HTTP 1.1 "application/x-www-form-urlencoded"
$req = Mojo::Message::Request->new;
@@ -274,30 +287,28 @@ $req->parse("POST /foo/bar/baz.html?foo=13#23 HTTP/1.1\x0d\x0a");
$req->parse("Content-Length: 26\x0d\x0a");
$req->parse("Content-Type: application/x-www-form-urlencoded\x0d\x0a");
$req->parse("\x0d\x0afoo=bar&+tset=23+;&foo=bar");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is( $req->headers->content_type,
- 'application/x-www-form-urlencoded',
- 'right "Content-Type" value'
-);
-is($req->content->asset->size, 26, 'right size');
-is($req->content->asset->slurp, 'foo=bar&+tset=23+;&foo=bar',
- 'right content');
-is($req->body_params, 'foo=bar&+tset=23+&foo=bar', 'right parameters');
-is_deeply($req->body_params->to_hash->{foo}, [qw/bar bar/], 'right values');
-is_deeply($req->body_params->to_hash->{' tset'}, '23 ', 'right value');
-is_deeply($req->params->to_hash->{foo}, [qw/bar bar 13/], 'right values');
-is_deeply([$req->param('foo')], [qw/bar bar 13/], 'right values');
-is_deeply($req->param(' tset'), '23 ', 'right value');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_type,
+ 'application/x-www-form-urlencoded',
+ 'right "Content-Type" value';
+is $req->content->asset->size, 26, 'right size';
+is $req->content->asset->slurp, 'foo=bar&+tset=23+;&foo=bar', 'right content';
+is $req->body_params, 'foo=bar&+tset=23+&foo=bar', 'right parameters';
+is_deeply $req->body_params->to_hash->{foo}, [qw/bar bar/], 'right values';
+is_deeply $req->body_params->to_hash->{' tset'}, '23 ', 'right value';
+is_deeply $req->params->to_hash->{foo}, [qw/bar bar 13/], 'right values';
+is_deeply [$req->param('foo')], [qw/bar bar 13/], 'right values';
+is_deeply $req->param(' tset'), '23 ', 'right value';
$req->param('set', 'single');
-is_deeply($req->param('set'), 'single', 'setting single param works');
+is_deeply $req->param('set'), 'single', 'setting single param works';
$req->param('multi', 1, 2, 3);
-is_deeply([$req->param('multi')],
- [qw/1 2 3/], 'setting multiple value param works');
-is($req->param('test23'), undef, 'no value');
+is_deeply [$req->param('multi')],
+ [qw/1 2 3/], 'setting multiple value param works';
+is $req->param('test23'), undef, 'no value';
# Parse HTTP 1.1 chunked request with trailing headers
$req = Mojo::Message::Request->new;
@@ -312,18 +323,18 @@ $req->parse("abcdefghi\x0d\x0a");
$req->parse("0\x0d\x0a");
$req->parse("X-Trailer1: test\x0d\x0a");
$req->parse("X-Trailer2: 123\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL');
-is($req->query_params, 'foo=13&bar=23', 'right parameters');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->header('X-Trailer1'), 'test', 'right "X-Trailer1" value');
-is($req->headers->header('X-Trailer2'), '123', 'right "X-Trailer2" value');
-is($req->headers->content_length, 13, 'right "Content-Length" value');
-is($req->content->asset->size, 13, 'right size');
-is($req->content->asset->slurp, 'abcdabcdefghi', 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL';
+is $req->query_params, 'foo=13&bar=23', 'right parameters';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->header('X-Trailer1'), 'test', 'right "X-Trailer1" value';
+is $req->headers->header('X-Trailer2'), '123', 'right "X-Trailer2" value';
+is $req->headers->content_length, 13, 'right "Content-Length" value';
+is $req->content->asset->size, 13, 'right size';
+is $req->content->asset->slurp, 'abcdabcdefghi', 'right content';
# Parse HTTP 1.1 chunked request with trailing headers (different variation)
$req = Mojo::Message::Request->new;
@@ -336,18 +347,18 @@ $req->parse("abcd\x0d\x0a");
$req->parse("9\x0d\x0a");
$req->parse("abcdefghi\x0d\x0a");
$req->parse("0\x0d\x0aX-Trailer: 777\x0d\x0a\x0d\x0aLEFTOVER");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL');
-is($req->query_params, 'foo=13&bar=23', 'right parameters');
-ok(!defined $req->headers->transfer_encoding, 'no "Transfer-Encoding" value');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->header('X-Trailer'), '777', 'right "X-Trailer" value');
-is($req->headers->content_length, 13, 'right "Content-Length" value');
-is($req->content->asset->size, 13, 'right size');
-is($req->content->asset->slurp, 'abcdabcdefghi', 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL';
+is $req->query_params, 'foo=13&bar=23', 'right parameters';
+ok !defined $req->headers->transfer_encoding, 'no "Transfer-Encoding" value';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->header('X-Trailer'), '777', 'right "X-Trailer" value';
+is $req->headers->content_length, 13, 'right "Content-Length" value';
+is $req->content->asset->size, 13, 'right size';
+is $req->content->asset->slurp, 'abcdabcdefghi', 'right content';
# Parse HTTP 1.1 chunked request with trailing headers (different variation)
$req = Mojo::Message::Request->new;
@@ -361,18 +372,18 @@ $req->parse("9\x0d\x0a");
$req->parse("abcdefghi\x0d\x0a");
$req->parse(
"0\x0d\x0aX-Trailer1: test\x0d\x0aX-Trailer2: 123\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL');
-is($req->query_params, 'foo=13&bar=23', 'right parameters');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->header('X-Trailer1'), 'test', 'right "X-Trailer1" value');
-is($req->headers->header('X-Trailer2'), '123', 'right "X-Trailer2" value');
-is($req->headers->content_length, 13, 'right "Content-Length" value');
-is($req->content->asset->size, 13, 'right size');
-is($req->content->asset->slurp, 'abcdabcdefghi', 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL';
+is $req->query_params, 'foo=13&bar=23', 'right parameters';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->header('X-Trailer1'), 'test', 'right "X-Trailer1" value';
+is $req->headers->header('X-Trailer2'), '123', 'right "X-Trailer2" value';
+is $req->headers->content_length, 13, 'right "Content-Length" value';
+is $req->content->asset->size, 13, 'right size';
+is $req->content->asset->slurp, 'abcdabcdefghi', 'right content';
# Parse HTTP 1.1 chunked request with trailing headers (no Trailer header)
$req = Mojo::Message::Request->new;
@@ -385,18 +396,18 @@ $req->parse("9\x0d\x0a");
$req->parse("abcdefghi\x0d\x0a");
$req->parse(
"0\x0d\x0aX-Trailer1: test\x0d\x0aX-Trailer2: 123\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL');
-is($req->query_params, 'foo=13&bar=23', 'right parameters');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->header('X-Trailer1'), 'test', 'right "X-Trailer1" value');
-is($req->headers->header('X-Trailer2'), '123', 'right "X-Trailer2" value');
-is($req->headers->content_length, 13, 'right "Content-Length" value');
-is($req->content->asset->size, 13, 'right size');
-is($req->content->asset->slurp, 'abcdabcdefghi', 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13&bar=23#23', 'right URL';
+is $req->query_params, 'foo=13&bar=23', 'right parameters';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->header('X-Trailer1'), 'test', 'right "X-Trailer1" value';
+is $req->headers->header('X-Trailer2'), '123', 'right "X-Trailer2" value';
+is $req->headers->content_length, 13, 'right "Content-Length" value';
+is $req->content->asset->size, 13, 'right size';
+is $req->content->asset->slurp, 'abcdabcdefghi', 'right content';
# Parse HTTP 1.1 multipart request
$req = Mojo::Message::Request->new;
@@ -418,34 +429,29 @@ $req->parse("use strict;\n");
$req->parse("use warnings;\n\n");
$req->parse("print \"Hello World :)\\n\"\n");
$req->parse("\x0d\x0a------------0xKhTmLbOuNdArY--");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo13#23', 'right URL');
-is($req->query_params, 'foo13', 'right parameters');
-like($req->headers->content_type,
- qr/multipart\/form-data/, 'right "Content-Type" value');
-is(ref $req->content->parts->[0], 'Mojo::Content::Single', 'right part');
-is(ref $req->content->parts->[1], 'Mojo::Content::Single', 'right part');
-is(ref $req->content->parts->[2], 'Mojo::Content::Single', 'right part');
-is( $req->content->parts->[0]->asset->slurp,
- "hallo welt test123\n",
- 'right content'
-);
-is_deeply(
- $req->body_params->to_hash->{text1},
- "hallo welt test123\n",
- 'right value'
-);
-is_deeply($req->body_params->to_hash->{text2}, '', 'right value');
-is($req->upload('upload')->filename, 'hello.pl', 'right filename');
-is(ref $req->upload('upload')->asset, 'Mojo::Asset::File', 'right file');
-is($req->upload('upload')->asset->size, 69, 'right size');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo13#23', 'right URL';
+is $req->query_params, 'foo13', 'right parameters';
+like $req->headers->content_type,
+ qr/multipart\/form-data/, 'right "Content-Type" value';
+is ref $req->content->parts->[0], 'Mojo::Content::Single', 'right part';
+is ref $req->content->parts->[1], 'Mojo::Content::Single', 'right part';
+is ref $req->content->parts->[2], 'Mojo::Content::Single', 'right part';
+is $req->content->parts->[0]->asset->slurp, "hallo welt test123\n",
+ 'right content';
+is_deeply $req->body_params->to_hash->{text1}, "hallo welt test123\n",
+ 'right value';
+is_deeply $req->body_params->to_hash->{text2}, '', 'right value';
+is $req->upload('upload')->filename, 'hello.pl', 'right filename';
+is ref $req->upload('upload')->asset, 'Mojo::Asset::File', 'right file';
+is $req->upload('upload')->asset->size, 69, 'right size';
my $file = File::Spec->catfile(File::Temp::tempdir(CLEANUP => 1),
("MOJO_TMP." . time . ".txt"));
-ok($req->upload('upload')->move_to($file), 'moved file');
-is((unlink $file), 1, 'unlinked file');
+ok $req->upload('upload')->move_to($file), 'moved file';
+is unlink($file), 1, 'unlinked file';
# Parse full HTTP 1.1 proxy request with basic authorization
$req = Mojo::Message::Request->new;
@@ -456,17 +462,15 @@ $req->parse(
"Proxy-Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==\x0d\x0a");
$req->parse("Content-Length: 13\x0d\x0a\x0d\x0a");
$req->parse("Hello World!\n");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is( $req->url->base,
- 'http://Aladdin:open%20sesame@127.0.0.1',
- 'right base URL'
-);
-is($req->url->base->userinfo, 'Aladdin:open sesame', 'right base userinfo');
-is($req->url, 'http://127.0.0.1/foo/bar', 'right URL');
-is($req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url->base, 'http://Aladdin:open%20sesame@127.0.0.1',
+ 'right base URL';
+is $req->url->base->userinfo, 'Aladdin:open sesame', 'right base userinfo';
+is $req->url, 'http://127.0.0.1/foo/bar', 'right URL';
+is $req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo';
# Parse full HTTP 1.1 proxy connect request with basic authorization
$req = Mojo::Message::Request->new;
@@ -475,25 +479,25 @@ $req->parse("Host: 127.0.0.1\x0d\x0a");
$req->parse(
"Proxy-Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==\x0d\x0a");
$req->parse("Content-Length: 0\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'CONNECT', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '127.0.0.1:3000', 'right URL');
-is($req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo');
+ok $req->is_done, 'request is done';
+is $req->method, 'CONNECT', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '127.0.0.1:3000', 'right URL';
+is $req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo';
# Build minimal HTTP 1.1 request
$req = Mojo::Message::Request->new;
$req->method('GET');
$req->url->parse('http://127.0.0.1/');
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1/', 'right absolute URL');
-is($req->headers->host, '127.0.0.1', 'right "Host" value');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1/', 'right absolute URL';
+is $req->headers->host, '127.0.0.1', 'right "Host" value';
# Build HTTP 1.1 start line and header
$req = Mojo::Message::Request->new;
@@ -501,49 +505,49 @@ $req->method('GET');
$req->url->parse('http://127.0.0.1/foo/bar');
$req->headers->expect('100-continue');
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->headers->host, '127.0.0.1', 'right "Host" value');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->headers->host, '127.0.0.1', 'right "Host" value';
# Build full HTTP 1.1 request
$req = Mojo::Message::Request->new;
$finished = undef;
-$req->finish_cb(sub { $finished = shift->is_done });
+$req->on_finish(sub { $finished = shift->is_done });
$req->method('get');
$req->url->parse('http://127.0.0.1/foo/bar');
$req->headers->expect('100-continue');
$req->body("Hello World!\n");
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->headers->host, '127.0.0.1', 'right "Host" value');
-is($req->headers->content_length, '13', 'right "Content-Length" value');
-is($req->body, "Hello World!\n", 'right content');
-ok($finished, 'finish callback was called');
-ok($req->is_done, 'request is done');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->headers->host, '127.0.0.1', 'right "Host" value';
+is $req->headers->content_length, '13', 'right "Content-Length" value';
+is $req->body, "Hello World!\n", 'right content';
+ok $finished, 'finish callback was called';
+ok $req->is_done, 'request is done';
# Build HTTP 1.1 request body
$req = Mojo::Message::Request->new;
$finished = undef;
-$req->finish_cb(sub { $finished = shift->is_done });
+$req->on_finish(sub { $finished = shift->is_done });
$req->method('get');
$req->url->parse('http://127.0.0.1/foo/bar');
$req->headers->expect('100-continue');
$req->body("Hello World!\n");
my $i = 0;
while (my $chunk = $req->get_body_chunk($i)) { $i += length $chunk }
-ok($finished, 'finish callback was called');
-ok($req->is_done, 'request is done');
+ok $finished, 'finish callback was called';
+ok $req->is_done, 'request is done';
# Build WebSocket handshake request
$req = Mojo::Message::Request->new;
@@ -558,30 +562,26 @@ $req->headers->sec_websocket_key1('4 @1 46546xW%0l 1 5');
$req->headers->origin('http://example.com');
$req->body('^n:ds[4U');
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/demo', 'right URL');
-is($req->url->to_abs, 'http://example.com/demo', 'right absolute URL');
-is($req->headers->connection, 'Upgrade', 'right "Connection" value');
-is($req->headers->upgrade, 'WebSocket', 'right "Upgrade" value');
-is($req->headers->host, 'example.com', 'right "Host" value');
-is($req->headers->content_length, '8', 'right "Content-Length" value');
-is($req->headers->origin, 'http://example.com', 'right "Origin" value');
-is( $req->headers->sec_websocket_key1,
- "4 \@1 46546xW%0l 1 5",
- 'right "Sec-WebSocket-Key1" value'
-);
-is( $req->headers->sec_websocket_key2,
- '12998 5 Y3 1 .P00',
- 'right "Sec-WebSocket-Key2" value'
-);
-is($req->headers->sec_websocket_protocol,
- 'sample', 'right "Sec-WebSocket-Protocol" value');
-is($req->body, '^n:ds[4U', 'right content');
-ok($finished, 'finish callback was called');
-ok($req->is_done, 'request is done');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/demo', 'right URL';
+is $req->url->to_abs, 'http://example.com/demo', 'right absolute URL';
+is $req->headers->connection, 'Upgrade', 'right "Connection" value';
+is $req->headers->upgrade, 'WebSocket', 'right "Upgrade" value';
+is $req->headers->host, 'example.com', 'right "Host" value';
+is $req->headers->content_length, '8', 'right "Content-Length" value';
+is $req->headers->origin, 'http://example.com', 'right "Origin" value';
+is $req->headers->sec_websocket_key1, "4 \@1 46546xW%0l 1 5",
+ 'right "Sec-WebSocket-Key1" value';
+is $req->headers->sec_websocket_key2, '12998 5 Y3 1 .P00',
+ 'right "Sec-WebSocket-Key2" value';
+is $req->headers->sec_websocket_protocol, 'sample',
+ 'right "Sec-WebSocket-Protocol" value';
+is $req->body, '^n:ds[4U', 'right content';
+ok $finished, 'finish callback was called';
+ok $req->is_done, 'request is done';
# Build full HTTP 1.1 proxy request
@@ -592,16 +592,16 @@ $req->headers->expect('100-continue');
$req->body("Hello World!\n");
$req->proxy('http://127.0.0.2:8080');
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, 'http://127.0.0.1/foo/bar', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->headers->host, '127.0.0.1', 'right "Host" value');
-is($req->headers->content_length, '13', 'right "Content-Length" value');
-is($req->body, "Hello World!\n", 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, 'http://127.0.0.1/foo/bar', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->headers->host, '127.0.0.1', 'right "Host" value';
+is $req->headers->content_length, '13', 'right "Content-Length" value';
+is $req->body, "Hello World!\n", 'right content';
# Build full HTTP 1.1 proxy request with basic authorization
$req = Mojo::Message::Request->new;
@@ -611,25 +611,21 @@ $req->headers->expect('100-continue');
$req->body("Hello World!\n");
$req->proxy('http://Aladdin:open%20sesame@127.0.0.2:8080');
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, 'http://127.0.0.1/foo/bar', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL');
-is($req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo');
-is( $req->headers->authorization,
- 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
- 'right "Authorization" value'
-);
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->headers->host, '127.0.0.1', 'right "Host" value');
-is( $req->headers->proxy_authorization,
- 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
- 'right "Proxy-Authorization" value'
-);
-is($req->headers->content_length, '13', 'right "Content-Length" value');
-is($req->body, "Hello World!\n", 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, 'http://127.0.0.1/foo/bar', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL';
+is $req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo';
+is $req->headers->authorization, 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
+ 'right "Authorization" value';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->headers->host, '127.0.0.1', 'right "Host" value';
+is $req->headers->proxy_authorization, 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
+ 'right "Proxy-Authorization" value';
+is $req->headers->content_length, '13', 'right "Content-Length" value';
+is $req->body, "Hello World!\n", 'right content';
# Build full HTTP 1.1 proxy connect request with basic authorization
$req = Mojo::Message::Request->new;
@@ -637,25 +633,19 @@ $req->method('CONNECT');
$req->url->parse('http://Aladdin:open%20sesame@127.0.0.1:3000/foo/bar');
$req->proxy('http://Aladdin:open%20sesame@127.0.0.2:8080');
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'CONNECT', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '127.0.0.1:3000', 'right URL');
-is( $req->url->to_abs,
- 'http://Aladdin:open%20sesame@127.0.0.1:3000/',
- 'right absolute URL'
-);
-is($req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo');
-is( $req->headers->authorization,
- 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
- 'right "Authorization" value'
-);
-is($req->headers->host, '127.0.0.1:3000', 'right "Host" value');
-is( $req->headers->proxy_authorization,
- 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
- 'right "Proxy-Authorization" value'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'CONNECT', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '127.0.0.1:3000', 'right URL';
+is $req->url->to_abs, 'http://Aladdin:open%20sesame@127.0.0.1:3000/',
+ 'right absolute URL';
+is $req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo';
+is $req->headers->authorization, 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
+ 'right "Authorization" value';
+is $req->headers->host, '127.0.0.1:3000', 'right "Host" value';
+is $req->headers->proxy_authorization, 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==',
+ 'right "Proxy-Authorization" value';
# Build HTTP 1.1 multipart request
$req = Mojo::Message::Request->new;
@@ -670,140 +660,123 @@ $content->asset->add_chunk("lala\nfoobar\nperl rocks\n");
$content->headers->content_type('text/plain');
push @{$req->content->parts}, $content;
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL');
-is($req->headers->host, '127.0.0.1', 'right "Host" value');
-is($req->headers->content_length, '104', 'right "Content-Length" value');
-is( $req->headers->content_type,
- 'multipart/mixed; boundary=7am1X',
- 'right "Content-Type" value'
-);
-is( $req->content->parts->[0]->asset->slurp,
- 'Hallo Welt lalalala!',
- 'right content'
-);
-is($req->content->parts->[1]->headers->content_type,
- 'text/plain', 'right "Content-Type" value');
-is( $req->content->parts->[1]->asset->slurp,
- "lala\nfoobar\nperl rocks\n",
- 'right content'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL';
+is $req->headers->host, '127.0.0.1', 'right "Host" value';
+is $req->headers->content_length, '104', 'right "Content-Length" value';
+is $req->headers->content_type, 'multipart/mixed; boundary=7am1X',
+ 'right "Content-Type" value';
+is $req->content->parts->[0]->asset->slurp, 'Hallo Welt lalalala!',
+ 'right content';
+is $req->content->parts->[1]->headers->content_type, 'text/plain',
+ 'right "Content-Type" value';
+is $req->content->parts->[1]->asset->slurp, "lala\nfoobar\nperl rocks\n",
+ 'right content';
# Build HTTP 1.1 chunked request
$req = Mojo::Message::Request->new;
$req->method('GET');
$req->url->parse('http://127.0.0.1:8080/foo/bar');
$req->headers->transfer_encoding('chunked');
-my $counter = 1;
-my $chunked = Mojo::Filter::Chunked->new;
my $counter2 = 0;
-$req->progress_cb(sub { $counter2++ });
-$req->body(
- sub {
- my $self = shift;
- my $chunk = '';
- $chunk = "hello world!" if $counter == 1;
- $chunk = "hello world2!\n\n" if $counter == 2;
- $counter++;
- return $chunked->build($chunk);
+$req->on_progress(sub { $counter2++ });
+$req->write_chunk(
+ 'hello world!' => sub {
+ shift->write_chunk(
+ "hello world2!\n\n" => sub {
+ my $self = shift;
+ $self->write_chunk('');
+ }
+ );
}
);
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1:8080/foo/bar', 'right absolute URL');
-is($req->headers->host, '127.0.0.1:8080', 'right "Host" value');
-is($req->headers->transfer_encoding, undef, 'no "Transfer-Encoding" value');
-is($req->body, "hello world!hello world2!\n\n", 'right content');
-ok($counter2, 'right counter');
-
-# Build HTTP 1.1 chunked request with trailing headers
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1:8080/foo/bar', 'right absolute URL';
+is $req->headers->host, '127.0.0.1:8080', 'right "Host" value';
+is $req->headers->transfer_encoding, undef, 'no "Transfer-Encoding" value';
+is $req->body, "hello world!hello world2!\n\n", 'right content';
+ok $counter2, 'right counter';
+
+# Build HTTP 1.1 chunked request
$req = Mojo::Message::Request->new;
$req->method('GET');
$req->url->parse('http://127.0.0.1/foo/bar');
-$req->headers->transfer_encoding('chunked');
-$req->headers->trailer('X-Test; X-Test2');
-$counter = 1;
-$chunked = Mojo::Filter::Chunked->new;
-$req->body_cb(
- sub {
- my $self = shift;
- my $chunk = Mojo::Headers->new;
- $chunk->header('X-Test', 'test');
- $chunk->header('X-Test2', '123');
- $chunk = "hello world!" if $counter == 1;
- $chunk = "hello world2!\n\n" if $counter == 2;
- $counter++;
- return $chunked->build($chunk);
- }
-);
+$req->write_chunk('hello world!');
+$req->write_chunk("hello world2!\n\n");
+$req->write_chunk('');
$req = Mojo::Message::Request->new->parse($req->build);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/foo/bar', 'right URL');
-is($req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL');
-is($req->headers->trailer, 'X-Test; X-Test2', 'right "Trailer" value');
-is($req->headers->host, '127.0.0.1', 'right "Host" value');
-is($req->headers->transfer_encoding, undef, 'no "Transfer-Encoding" value');
-is($req->headers->header('X-Test'), 'test', 'right "X-Test" value');
-is($req->headers->header('X-Test2'), '123', 'right "X-Test2" value');
-is($req->body, "hello world!hello world2!\n\n", 'right content');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/foo/bar', 'right URL';
+is $req->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL';
+is $req->headers->host, '127.0.0.1', 'right "Host" value';
+is $req->headers->transfer_encoding, undef, 'no "Transfer-Encoding" value';
+is $req->body, "hello world!hello world2!\n\n", 'right content';
# Status code and message
my $res = Mojo::Message::Response->new;
-is($res->code, undef, 'no status');
-is($res->default_message, 'OK', 'right default message');
-is($res->message, undef, 'no message');
+is $res->code, undef, 'no status';
+is $res->default_message, 'OK', 'right default message';
+is $res->message, undef, 'no message';
$res->message('Test');
-is($res->message, 'Test', 'right message');
+is $res->message, 'Test', 'right message';
$res->code(500);
-is($res->code, 500, 'right status');
-is($res->message, 'Test', 'right message');
-is($res->default_message, 'Internal Server Error', 'right default message');
+is $res->code, 500, 'right status';
+is $res->message, 'Test', 'right message';
+is $res->default_message, 'Internal Server Error', 'right default message';
$res = Mojo::Message::Response->new;
-is($res->code(400)->default_message, 'Bad Request', 'right default message');
+is $res->code(400)->default_message, 'Bad Request', 'right default message';
# Parse HTTP 1.1 response start line, no headers and body
$res = Mojo::Message::Response->new;
$res->parse("HTTP/1.1 200 OK\x0d\x0a\x0d\x0a");
-ok($res->is_done, 'response is done');
-is($res->code, 200, 'right status');
-is($res->message, 'OK', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
+ok $res->is_done, 'response is done';
+is $res->code, 200, 'right status';
+is $res->message, 'OK', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+
+# Parse HTTP 1.1 response start line, no headers and body (no message)
+$res = Mojo::Message::Response->new;
+$res->parse("HTTP/1.1 200\x0d\x0a\x0d\x0a");
+ok $res->is_done, 'response is done';
+is $res->code, 200, 'right status';
+is $res->message, undef, 'no message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
# Parse HTTP 0.9 response
$res = Mojo::Message::Response->new;
$res->parse("HTT... this is just a document and valid HTTP 0.9\n\n");
-ok($res->is_done, 'response is done');
-is($res->major_version, 0, 'right major version');
-is($res->minor_version, 9, 'right minor version');
-is( $res->body,
- "HTT... this is just a document and valid HTTP 0.9\n\n",
- 'right content'
-);
+ok $res->is_done, 'response is done';
+is $res->major_version, 0, 'right major version';
+is $res->minor_version, 9, 'right minor version';
+is $res->body, "HTT... this is just a document and valid HTTP 0.9\n\n",
+ 'right content';
# Parse HTTP 1.0 response start line and headers but no body
$res = Mojo::Message::Response->new;
$res->parse("HTTP/1.0 404 Damn it\x0d\x0a");
$res->parse("Content-Type: text/plain\x0d\x0a");
$res->parse("Content-Length: 0\x0d\x0a\x0d\x0a");
-ok($res->is_done, 'response is done');
-is($res->code, 404, 'right status');
-is($res->message, 'Damn it', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 0, 'right minor version');
-is($res->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($res->headers->content_length, 0, 'right "Content-Length" value');
+ok !$res->is_done, 'response is not done';
+is $res->code, 404, 'right status';
+is $res->message, 'Damn it', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 0, 'right minor version';
+is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $res->headers->content_length, 0, 'right "Content-Length" value';
# Parse full HTTP 1.0 response
$res = Mojo::Message::Response->new;
@@ -811,13 +784,57 @@ $res->parse("HTTP/1.0 500 Internal Server Error\x0d\x0a");
$res->parse("Content-Type: text/plain\x0d\x0a");
$res->parse("Content-Length: 27\x0d\x0a\x0d\x0a");
$res->parse("Hello World!\n1234\nlalalala\n");
-ok($res->is_done, 'response is done');
-is($res->code, 500, 'right status');
-is($res->message, 'Internal Server Error', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 0, 'right minor version');
-is($res->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($res->headers->content_length, 27, 'right "Content-Length" value');
+ok !$res->is_done, 'response is not done';
+is $res->code, 500, 'right status';
+is $res->message, 'Internal Server Error', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 0, 'right minor version';
+is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $res->headers->content_length, 27, 'right "Content-Length" value';
+
+# Parse full HTTP 1.0 response (missing Content-Length)
+$res = Mojo::Message::Response->new;
+$res->parse("HTTP/1.0 500 Internal Server Error\x0d\x0a");
+$res->parse("Content-Type: text/plain\x0d\x0a");
+$res->parse("Connection: close\x0d\x0a\x0d\x0a");
+$res->parse("Hello World!\n1234\nlalalala\n");
+ok !$res->is_done, 'response is not done';
+is $res->code, 500, 'right status';
+is $res->message, 'Internal Server Error', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 0, 'right minor version';
+is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $res->headers->content_length, undef, 'no "Content-Length" value';
+is $res->body, "Hello World!\n1234\nlalalala\n", 'right content';
+
+# Parse full HTTP 1.0 response (missing Content-Length and Connection)
+$res = Mojo::Message::Response->new;
+$res->parse("HTTP/1.0 500 Internal Server Error\x0d\x0a");
+$res->parse("Content-Type: text/plain\x0d\x0a\x0d\x0a");
+$res->parse("Hello World!\n1234\nlalalala\n");
+ok !$res->is_done, 'response is not done';
+is $res->code, 500, 'right status';
+is $res->message, 'Internal Server Error', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 0, 'right minor version';
+is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $res->headers->content_length, undef, 'no "Content-Length" value';
+is $res->body, "Hello World!\n1234\nlalalala\n", 'right content';
+
+# Parse full HTTP 1.1 response (missing Content-Length)
+$res = Mojo::Message::Response->new;
+$res->parse("HTTP/1.1 500 Internal Server Error\x0d\x0a");
+$res->parse("Content-Type: text/plain\x0d\x0a");
+$res->parse("Connection: close\x0d\x0a\x0d\x0a");
+$res->parse("Hello World!\n1234\nlalalala\n");
+ok !$res->is_done, 'response is not done';
+is $res->code, 500, 'right status';
+is $res->message, 'Internal Server Error', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $res->headers->content_length, undef, 'no "Content-Length" value';
+is $res->body, "Hello World!\n1234\nlalalala\n", 'right content';
# Parse HTTP 1.1 response (413 error in one big chunk)
$res = Mojo::Message::Response->new;
@@ -826,12 +843,12 @@ $res->parse("HTTP/1.1 413 Request Entity Too Large\x0d\x0a"
. "Date: Tue, 09 Feb 2010 16:34:51 GMT\x0d\x0a"
. "Server: Mojolicious (Perl)\x0d\x0a"
. "X-Powered-By: Mojolicious (Perl)\x0d\x0a\x0d\x0a");
-ok($res->is_done, 'response is done');
-is($res->code, 413, 'right status');
-is($res->message, 'Request Entity Too Large', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-is($res->headers->content_length, undef, 'right "Content-Length" value');
+ok !$res->is_done, 'response is not done';
+is $res->code, 413, 'right status';
+is $res->message, 'Request Entity Too Large', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->content_length, undef, 'right "Content-Length" value';
# Parse HTTP 1.1 chunked response
$res = Mojo::Message::Response->new;
@@ -843,14 +860,14 @@ $res->parse("abcd\x0d\x0a");
$res->parse("9\x0d\x0a");
$res->parse("abcdefghi\x0d\x0a");
$res->parse("0\x0d\x0a\x0d\x0a");
-ok($res->is_done, 'response is done');
-is($res->code, 500, 'right status');
-is($res->message, 'Internal Server Error', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-is($res->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($res->headers->content_length, 13, 'right "Content-Length" value');
-is($res->content->body_size, 13, 'right size');
+ok $res->is_done, 'response is done';
+is $res->code, 500, 'right status';
+is $res->message, 'Internal Server Error', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $res->headers->content_length, 13, 'right "Content-Length" value';
+is $res->content->body_size, 13, 'right size';
# Parse HTTP 1.1 multipart response
$res = Mojo::Message::Response->new;
@@ -872,30 +889,31 @@ $res->parse("use strict;\n");
$res->parse("use warnings;\n\n");
$res->parse("print \"Hello World :)\\n\"\n");
$res->parse("\x0d\x0a------------0xKhTmLbOuNdArY--");
-ok($res->is_done, 'response is done');
-is($res->code, 200, 'right status');
-is($res->message, 'OK', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-ok($res->headers->content_type =~ /multipart\/form-data/,
- 'right "Content-Type" value');
-is(ref $res->content->parts->[0], 'Mojo::Content::Single', 'right part');
-is(ref $res->content->parts->[1], 'Mojo::Content::Single', 'right part');
-is(ref $res->content->parts->[2], 'Mojo::Content::Single', 'right part');
-is( $res->content->parts->[0]->asset->slurp,
- "hallo welt test123\n",
- 'right content'
-);
+ok $res->is_done, 'response is done';
+is $res->code, 200, 'right status';
+is $res->message, 'OK', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+ok $res->headers->content_type =~ /multipart\/form-data/,
+ 'right "Content-Type" value';
+is ref $res->content->parts->[0], 'Mojo::Content::Single', 'right part';
+is ref $res->content->parts->[1], 'Mojo::Content::Single', 'right part';
+is ref $res->content->parts->[2], 'Mojo::Content::Single', 'right part';
+is $res->content->parts->[0]->asset->slurp, "hallo welt test123\n",
+ 'right content';
# Build HTTP 1.1 response start line with minimal headers
$res = Mojo::Message::Response->new;
$res->code(404);
$res->headers->date('Sun, 17 Aug 2008 16:27:35 GMT');
-is( $res->build,
- "HTTP/1.1 404 Not Found\x0d\x0a"
- . "Date: Sun, 17 Aug 2008 16:27:35 GMT\x0d\x0a\x0d\x0a",
- 'right message'
-);
+$res = Mojo::Message::Response->new->parse($res->build);
+ok $res->is_done, 'request is done';
+is $res->code, '404', 'right status';
+is $res->message, 'Not Found', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT', 'right "Date" value';
+is $res->headers->content_length, 0, 'right "Content-Length" value';
# Build HTTP 1.1 response start line and header
$res = Mojo::Message::Response->new;
@@ -903,14 +921,14 @@ $res->code(200);
$res->headers->connection('keep-alive');
$res->headers->date('Sun, 17 Aug 2008 16:27:35 GMT');
$res = Mojo::Message::Response->new->parse($res->build);
-ok($res->is_done, 'request is done');
-is($res->code, '200', 'right status');
-is($res->message, 'OK', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-is($res->headers->connection, 'keep-alive', 'right "Connection" value');
-is($res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT',
- 'right "Date" value');
+ok $res->is_done, 'request is done';
+is $res->code, '200', 'right status';
+is $res->message, 'OK', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->connection, 'keep-alive', 'right "Connection" value';
+is $res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT', 'right "Date" value';
+is $res->headers->content_length, 0, 'right "Content-Length" value';
# Build full HTTP 1.1 response
$res = Mojo::Message::Response->new;
@@ -919,36 +937,31 @@ $res->headers->connection('keep-alive');
$res->headers->date('Sun, 17 Aug 2008 16:27:35 GMT');
$res->body("Hello World!\n");
$res = Mojo::Message::Response->new->parse($res->build);
-ok($res->is_done, 'request is done');
-is($res->code, '200', 'right status');
-is($res->message, 'OK', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-is($res->headers->connection, 'keep-alive', 'right "Connection" value');
-is($res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT',
- 'right "Date" value');
-is($res->headers->content_length, '13', 'right "Content-Length" value');
-is($res->body, "Hello World!\n", 'right content');
+ok $res->is_done, 'request is done';
+is $res->code, '200', 'right status';
+is $res->message, 'OK', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->connection, 'keep-alive', 'right "Connection" value';
+is $res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT', 'right "Date" value';
+is $res->headers->content_length, '13', 'right "Content-Length" value';
+is $res->body, "Hello World!\n", 'right content';
# Build HTTP 0.9 response
$res = Mojo::Message::Response->new;
$res->major_version(0);
$res->minor_version(9);
$res->body("this is just a document and valid HTTP 0.9\nlalala\n");
-is( $res->build,
- "this is just a document and valid HTTP 0.9\nlalala\n",
- 'right message'
-);
+is $res->build, "this is just a document and valid HTTP 0.9\nlalala\n",
+ 'right message';
$res = Mojo::Message::Response->new->parse($res->build);
-ok($res->is_done, 'request is done');
-is($res->code, undef, 'no status');
-is($res->message, undef, 'no message');
-is($res->major_version, 0, 'right major version');
-is($res->minor_version, 9, 'right minor version');
-is( $res->body,
- "this is just a document and valid HTTP 0.9\nlalala\n",
- 'right content'
-);
+ok $res->is_done, 'request is done';
+is $res->code, undef, 'no status';
+is $res->message, undef, 'no message';
+is $res->major_version, 0, 'right major version';
+is $res->minor_version, 9, 'right minor version';
+is $res->body, "this is just a document and valid HTTP 0.9\nlalala\n",
+ 'right content';
# Build HTTP 1.1 multipart response
$res = Mojo::Message::Response->new;
@@ -964,28 +977,21 @@ $content->asset->add_chunk("lala\nfoobar\nperl rocks\n");
$content->headers->content_type('text/plain');
push @{$res->content->parts}, $content;
$res = Mojo::Message::Response->new->parse($res->build);
-ok($res->is_done, 'request is done');
-is($res->code, 200, 'right status');
-is($res->message, 'OK', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-is($res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT',
- 'right "Date" value');
-is($res->headers->content_length, '108', 'right "Content-Length" value');
-is( $res->headers->content_type,
- 'multipart/mixed; boundary=7am1X',
- 'right "Content-Type" value'
-);
-is( $res->content->parts->[0]->asset->slurp,
- 'Hallo Welt lalalalalala!',
- 'right content'
-);
-is($res->content->parts->[1]->headers->content_type,
- 'text/plain', 'right "Content-Type" value');
-is( $res->content->parts->[1]->asset->slurp,
- "lala\nfoobar\nperl rocks\n",
- 'right content'
-);
+ok $res->is_done, 'request is done';
+is $res->code, 200, 'right status';
+is $res->message, 'OK', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT', 'right "Date" value';
+is $res->headers->content_length, '108', 'right "Content-Length" value';
+is $res->headers->content_type, 'multipart/mixed; boundary=7am1X',
+ 'right "Content-Type" value';
+is $res->content->parts->[0]->asset->slurp, 'Hallo Welt lalalalalala!',
+ 'right content';
+is $res->content->parts->[1]->headers->content_type, 'text/plain',
+ 'right "Content-Type" value';
+is $res->content->parts->[1]->asset->slurp, "lala\nfoobar\nperl rocks\n",
+ 'right content';
# Parse IIS 7.5 like CGI environment (root)
$req = Mojo::Message::Request->new;
@@ -1003,18 +1009,17 @@ $req->parse(
HTTP_HOST => 'test',
SERVER_PROTOCOL => 'HTTP/1.1'
);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is( $req->headers->header('Accept'),
- 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
- 'right "Accept" value'
-);
-is($req->url->path, '/', 'right URL');
-is($req->url->base->path, '/index.pl/', 'right path');
-is($req->url->base->host, 'test', 'right host');
-ok(!$req->url->query, 'no query');
-is($req->minor_version, '1', 'right minor version');
-is($req->major_version, '1', 'right major version');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->headers->header('Accept'),
+ 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
+ 'right "Accept" value';
+is $req->url->path, '/', 'right URL';
+is $req->url->base->path, '/index.pl/', 'right path';
+is $req->url->base->host, 'test', 'right host';
+ok !$req->url->query, 'no query';
+is $req->minor_version, '1', 'right minor version';
+is $req->major_version, '1', 'right major version';
# Parse IIS 7.5 like CGI environment (with path)
$req = Mojo::Message::Request->new;
@@ -1032,18 +1037,17 @@ $req->parse(
HTTP_HOST => 'test',
SERVER_PROTOCOL => 'HTTP/1.1'
);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is( $req->headers->header('Accept'),
- 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
- 'right "Accept" value'
-);
-is($req->url->path, '/foo', 'right URL');
-is($req->url->base->path, '/index.pl/', 'right path');
-is($req->url->base->host, 'test', 'right host');
-ok(!$req->url->query, 'no query');
-is($req->minor_version, '1', 'right minor version');
-is($req->major_version, '1', 'right major version');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->headers->header('Accept'),
+ 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
+ 'right "Accept" value';
+is $req->url->path, '/foo', 'right URL';
+is $req->url->base->path, '/index.pl/', 'right path';
+is $req->url->base->host, 'test', 'right host';
+ok !$req->url->query, 'no query';
+is $req->minor_version, '1', 'right minor version';
+is $req->major_version, '1', 'right major version';
# Parse IIS 6.0 like CGI environment variables and a body
$req = Mojo::Message::Request->new;
@@ -1061,23 +1065,21 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/bar', 'right URL');
-is($req->url->base->path, '/foo/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right value');
-is( $req->url->to_abs->to_string,
- 'http://localhost:8080/foo/bar?lalala=23&bar=baz',
- 'right absolute URL'
-);
-is($req->env->{HTTP_EXPECT}, '100-continue', 'right "Expect" value');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/bar', 'right URL';
+is $req->url->base->path, '/foo/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right value';
+is $req->url->to_abs->to_string,
+ 'http://localhost:8080/foo/bar?lalala=23&bar=baz', 'right absolute URL';
+is $req->env->{HTTP_EXPECT}, '100-continue', 'right "Expect" value';
# Parse IIS 6.0 like CGI environment variables and a body (root)
$req = Mojo::Message::Request->new;
@@ -1095,22 +1097,20 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/foo/bar', 'right URL');
-is($req->url->base->path, '/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right value');
-is( $req->url->to_abs->to_string,
- 'http://localhost:8080/foo/bar?lalala=23&bar=baz',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/foo/bar', 'right URL';
+is $req->url->base->path, '/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right value';
+is $req->url->to_abs->to_string,
+ 'http://localhost:8080/foo/bar?lalala=23&bar=baz', 'right absolute URL';
# Parse IIS 6.0 like CGI environment variables and a body (trailing slash)
$req = Mojo::Message::Request->new;
@@ -1128,22 +1128,20 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/foo/bar/', 'right path');
-is($req->url->base->path, '/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right value');
-is( $req->url->to_abs->to_string,
- 'http://localhost:8080/foo/bar/?lalala=23&bar=baz',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/foo/bar/', 'right path';
+is $req->url->base->path, '/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right value';
+is $req->url->to_abs->to_string,
+ 'http://localhost:8080/foo/bar/?lalala=23&bar=baz', 'right absolute URL';
# Parse IIS 6.0 like CGI environment variables and a body
# (root and trailing slash)
@@ -1162,22 +1160,20 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/', 'right path');
-is($req->url->base->path, '/foo/bar/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right value');
-is( $req->url->to_abs->to_string,
- 'http://localhost:8080/foo/bar/?lalala=23&bar=baz',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/', 'right path';
+is $req->url->base->path, '/foo/bar/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right value';
+is $req->url->to_abs->to_string,
+ 'http://localhost:8080/foo/bar/?lalala=23&bar=baz', 'right absolute URL';
# Parse IIS 6.0 like CGI environment variables and a body (root)
$req = Mojo::Message::Request->new;
@@ -1195,22 +1191,20 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/', 'right path');
-is($req->url->base->path, '/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right value');
-is( $req->url->to_abs->to_string,
- 'http://localhost:8080/?lalala=23&bar=baz',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/', 'right path';
+is $req->url->base->path, '/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right value';
+is $req->url->to_abs->to_string, 'http://localhost:8080/?lalala=23&bar=baz',
+ 'right absolute URL';
# Parse Lighttpd like CGI environment variables and a body
$req = Mojo::Message::Request->new;
@@ -1225,21 +1219,20 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('Hello World');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/foo/bar', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'Hello World', 'right content');
-is( $req->url->to_abs->to_string,
- 'http://localhost:8080/test/index.cgi/foo/bar?lalala=23&bar=baz',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/foo/bar', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'Hello World', 'right content';
+is $req->url->to_abs->to_string,
+ 'http://localhost:8080/test/index.cgi/foo/bar?lalala=23&bar=baz',
+ 'right absolute URL';
# Parse Lighttpd like CGI environment variables and a body
# (behind reverse proxy)
@@ -1256,21 +1249,20 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('Hello World');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/foo/bar', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->url->base->host, 'mojolicious.org', 'right base host');
-is($req->url->base->port, '', 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'Hello World', 'right content');
-is( $req->url->to_abs->to_string,
- 'http://mojolicious.org/test/index.cgi/foo/bar?lalala=23&bar=baz',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/foo/bar', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->url->base->host, 'mojolicious.org', 'right base host';
+is $req->url->base->port, '', 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'Hello World', 'right content';
+is $req->url->to_abs->to_string,
+ 'http://mojolicious.org/test/index.cgi/foo/bar?lalala=23&bar=baz',
+ 'right absolute URL';
# Parse Apache like CGI environment variables and a body
$req = Mojo::Message::Request->new;
@@ -1286,22 +1278,21 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/foo/bar', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right value');
-is( $req->url->to_abs->to_string,
- 'http://localhost:8080/test/index.cgi/foo/bar?lalala=23&bar=baz',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/foo/bar', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right value';
+is $req->url->to_abs->to_string,
+ 'http://localhost:8080/test/index.cgi/foo/bar?lalala=23&bar=baz',
+ 'right absolute URL';
# Parse Apache like CGI environment variables with basic authorization
$req = Mojo::Message::Request->new;
@@ -1319,30 +1310,26 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->headers->expect, '100-continue', 'right "Expect" value');
-is($req->url->path, '/foo/bar', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->base->port, 8080, 'right base port');
-is($req->url->query, 'lalala=23&bar=baz', 'right query');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right value');
-is( $req->url->to_abs->to_string,
- 'http://Aladdin:open%20sesame@localhost:8080'
- . '/test/index.cgi/foo/bar?lalala=23&bar=baz',
- 'right absolute URL'
-);
-is( $req->url->base,
- 'http://Aladdin:open%20sesame@localhost:8080/test/index.cgi/',
- 'right base URL'
-);
-is($req->url->base->userinfo, 'Aladdin:open sesame', 'right userinfo');
-is($req->url, '/foo/bar?lalala=23&bar=baz', 'right URL');
-is($req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->headers->expect, '100-continue', 'right "Expect" value';
+is $req->url->path, '/foo/bar', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->base->port, 8080, 'right base port';
+is $req->url->query, 'lalala=23&bar=baz', 'right query';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right value';
+is $req->url->to_abs->to_string, 'http://Aladdin:open%20sesame@localhost:8080'
+ . '/test/index.cgi/foo/bar?lalala=23&bar=baz', 'right absolute URL';
+is $req->url->base,
+ 'http://Aladdin:open%20sesame@localhost:8080/test/index.cgi/',
+ 'right base URL';
+is $req->url->base->userinfo, 'Aladdin:open sesame', 'right userinfo';
+is $req->url, '/foo/bar?lalala=23&bar=baz', 'right URL';
+is $req->proxy->userinfo, 'Aladdin:open sesame', 'right proxy userinfo';
# Parse Apache 2.2 (win32) like CGI environment variables and a body
$req = Mojo::Message::Request->new;
@@ -1358,29 +1345,24 @@ $req->parse(
);
$req->parse('request=&ajax=true&login=test&password=111&');
$req->parse('edition=db6d8b30-16df-4ecd-be2f-c8194f94e1f4');
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->url->path, '', 'right path');
-is($req->url->base->path, '/index.pl/', 'right base path');
-is($req->url->base->host, 'test1', 'right base host');
-is($req->url->base->port, '', 'right base port');
-ok(!$req->url->query, 'no query');
-is($req->minor_version, '1', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is( $req->body,
- 'request=&ajax=true&login=test&password=111&'
- . 'edition=db6d8b30-16df-4ecd-be2f-c8194f94e1f4',
- 'right content'
-);
-is($req->param('ajax'), 'true', 'right value');
-is($req->param('login'), 'test', 'right value');
-is($req->param('password'), '111', 'right value');
-is( $req->param('edition'),
- 'db6d8b30-16df-4ecd-be2f-c8194f94e1f4',
- 'right value'
-);
-is($req->url->to_abs->to_string,
- 'http://test1/index.pl', 'right absolute URL');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->url->path, '', 'right path';
+is $req->url->base->path, '/index.pl/', 'right base path';
+is $req->url->base->host, 'test1', 'right base host';
+is $req->url->base->port, '', 'right base port';
+ok !$req->url->query, 'no query';
+is $req->minor_version, '1', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'request=&ajax=true&login=test&password=111&'
+ . 'edition=db6d8b30-16df-4ecd-be2f-c8194f94e1f4', 'right content';
+is $req->param('ajax'), 'true', 'right value';
+is $req->param('login'), 'test', 'right value';
+is $req->param('password'), '111', 'right value';
+is $req->param('edition'), 'db6d8b30-16df-4ecd-be2f-c8194f94e1f4',
+ 'right value';
+is $req->url->to_abs->to_string, 'http://test1/index.pl',
+ 'right absolute URL';
# Parse Apache 2.2.11 like CGI environment variables and a body
$req = Mojo::Message::Request->new;
@@ -1395,20 +1377,18 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->path, '/foo/bar', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->is_secure, undef, 'not secure');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right parameters');
-is( $req->url->to_abs->to_string,
- 'http://localhost/test/index.cgi/foo/bar',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->path, '/foo/bar', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->is_secure, undef, 'not secure';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right parameters';
+is $req->url->to_abs->to_string, 'http://localhost/test/index.cgi/foo/bar',
+ 'right absolute URL';
# Parse Apache 2.2.11 like CGI environment variables and a body (HTTPS)
$req = Mojo::Message::Request->new;
@@ -1424,20 +1404,18 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->path, '/foo/bar', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->is_secure, 1, 'is secure');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right parameters');
-is( $req->url->to_abs->to_string,
- 'http://localhost/test/index.cgi/foo/bar',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->path, '/foo/bar', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->is_secure, 1, 'is secure';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right parameters';
+is $req->url->to_abs->to_string, 'https://localhost/test/index.cgi/foo/bar',
+ 'right absolute URL';
# Parse Apache 2.2.11 like CGI environment variables and a body
# (trailing slash)
@@ -1453,19 +1431,17 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->path, '/foo/bar/', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right parameters');
-is( $req->url->to_abs->to_string,
- 'http://localhost/test/index.cgi/foo/bar/',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->path, '/foo/bar/', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right parameters';
+is $req->url->to_abs->to_string, 'http://localhost/test/index.cgi/foo/bar/',
+ 'right absolute URL';
# Parse Apache 2.2.11 like CGI environment variables and a body
# (no SCRIPT_NAME)
@@ -1480,17 +1456,17 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->path, '/foo/bar', 'right path');
-is($req->url->base->path, '', 'right base path');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right parameters');
-is($req->url->to_abs->to_string,
- 'http://localhost/foo/bar', 'right absolute URL');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->path, '/foo/bar', 'right path';
+is $req->url->base->path, '', 'right base path';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right parameters';
+is $req->url->to_abs->to_string, 'http://localhost/foo/bar',
+ 'right absolute URL';
# Parse Apache 2.2.11 like CGI environment variables and a body
# (no PATH_INFO)
@@ -1505,19 +1481,17 @@ $req->parse(
SERVER_PROTOCOL => 'HTTP/1.0'
);
$req->parse('hello=world');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->url->base->host, 'localhost', 'right base host');
-is($req->url->path, '', 'right path');
-is($req->url->base->path, '/test/index.cgi/', 'right base path');
-is($req->minor_version, '0', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is($req->body, 'hello=world', 'right content');
-is_deeply($req->param('hello'), 'world', 'right paramaters');
-is( $req->url->to_abs->to_string,
- 'http://localhost/test/index.cgi',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->url->base->host, 'localhost', 'right base host';
+is $req->url->path, '', 'right path';
+is $req->url->base->path, '/test/index.cgi/', 'right base path';
+is $req->minor_version, '0', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->body, 'hello=world', 'right content';
+is_deeply $req->param('hello'), 'world', 'right paramaters';
+is $req->url->to_abs->to_string, 'http://localhost/test/index.cgi',
+ 'right absolute URL';
# Parse Apache 2.2.9 like CGI environment variables (root without PATH_INFO)
$req = Mojo::Message::Request->new;
@@ -1530,20 +1504,65 @@ $req->parse(
REQUEST_URI => '/cgi-bin/bootylicious/bootylicious.pl',
SERVER_PROTOCOL => 'HTTP/1.1',
);
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->url->base->host, 'getbootylicious.org', 'right base host');
-is($req->url->path, '/', 'right path');
-is( $req->url->base->path,
- '/cgi-bin/bootylicious/bootylicious.pl/',
- 'right base path'
-);
-is($req->minor_version, '1', 'right minor version');
-is($req->major_version, '1', 'right major version');
-is( $req->url->to_abs->to_string,
- 'http://getbootylicious.org/cgi-bin/bootylicious/bootylicious.pl',
- 'right absolute URL'
-);
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->url->base->host, 'getbootylicious.org', 'right base host';
+is $req->url->path, '/', 'right path';
+is $req->url->base->path, '/cgi-bin/bootylicious/bootylicious.pl/',
+ 'right base path';
+is $req->minor_version, '1', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->url->to_abs->to_string,
+ 'http://getbootylicious.org/cgi-bin/bootylicious/bootylicious.pl',
+ 'right absolute URL';
+
+# Parse Apache mod_fastcgi like CGI environment variables
+# (multipart file upload)
+$req = Mojo::Message::Request->new;
+$req->parse(
+ SCRIPT_NAME => '',
+ SERVER_NAME => '127.0.0.1',
+ SERVER_ADMIN => '[no address given]',
+ PATH_INFO => '/diag/upload',
+ HTTP_CONNECTION => 'Keep-Alive',
+ REQUEST_METHOD => 'POST',
+ CONTENT_LENGTH => '135',
+ SCRIPT_FILENAME => '/tmp/SnLu1cQ3t2/test.fcgi',
+ SERVER_SOFTWARE => 'Apache/2.2.14 (Unix) mod_fastcgi/2.4.2',
+ QUERY_STRING => '',
+ REMOTE_PORT => '58232',
+ HTTP_USER_AGENT => 'Mojolicious (Perl)',
+ SERVER_PORT => '13028',
+ SERVER_SIGNATURE => '',
+ REMOTE_ADDR => '127.0.0.1',
+ CONTENT_TYPE => 'multipart/form-data; boundary=8jXGX',
+ SERVER_PROTOCOL => 'HTTP/1.1',
+ PATH => '/usr/local/bin:/usr/local/sbin:/usr/bin:/bin:/usr/sbin:/sbin',
+ REQUEST_URI => '/diag/upload',
+ GATEWAY_INTERFACE => 'CGI/1.1',
+ SERVER_ADDR => '127.0.0.1',
+ DOCUMENT_ROOT => '/tmp/SnLu1cQ3t2',
+ PATH_TRANSLATED => '/tmp/test.fcgi/diag/upload',
+ HTTP_HOST => '127.0.0.1:13028'
+);
+$req->parse("--8jXGX\x0d\x0a");
+$req->parse(
+ "Content-Disposition: form-data; name=\"file\"; filename=\"file\"\x0d\x0a"
+ . "Content-Type: application/octet-stream\x0d\x0a\x0d\x0a");
+$req->parse('11023456789');
+$req->parse("\x0d\x0a--8jXGX--");
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->url->base->host, '127.0.0.1', 'right base host';
+is $req->url->path, '/diag/upload', 'right path';
+is $req->url->base->path, '', 'no base path';
+is $req->minor_version, '1', 'right minor version';
+is $req->major_version, '1', 'right major version';
+is $req->url->to_abs->to_string,
+ 'http://127.0.0.1:13028/diag/upload',
+ 'right absolute URL';
+$file = $req->upload('file');
+is $file->slurp, '11023456789', 'right uploaded content';
# Parse response with cookie
$res = Mojo::Message::Response->new;
@@ -1552,24 +1571,22 @@ $res->parse("Content-Type: text/plain\x0d\x0a");
$res->parse("Content-Length: 27\x0d\x0a");
$res->parse("Set-Cookie: foo=bar; Version=1; Path=/test\x0d\x0a\x0d\x0a");
$res->parse("Hello World!\n1234\nlalalala\n");
-ok($req->is_done, 'request is done');
-is($res->code, 200, 'right status');
-is($res->message, 'OK', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 0, 'right minor version');
-is($res->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($res->headers->content_length, 27, 'right "Content-Length" value');
-is( $res->headers->set_cookie,
- 'foo=bar; Version=1; Path=/test',
- 'right "Set-Cookie" value'
-);
+ok $req->is_done, 'request is done';
+is $res->code, 200, 'right status';
+is $res->message, 'OK', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 0, 'right minor version';
+is $res->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $res->headers->content_length, 27, 'right "Content-Length" value';
+is $res->headers->set_cookie, 'foo=bar; Version=1; Path=/test',
+ 'right "Set-Cookie" value';
my $cookies = $res->cookies;
-is($cookies->[0]->name, 'foo', 'right name');
-is($cookies->[0]->value, 'bar', 'right value');
-is($cookies->[0]->version, 1, 'right version');
-is($cookies->[0]->path, '/test', 'right path');
-is($res->cookie('foo')->value, 'bar', 'right value');
-is($res->cookie('foo')->path, '/test', 'right path');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, 'bar', 'right value';
+is $cookies->[0]->version, 1, 'right version';
+is $cookies->[0]->path, '/test', 'right path';
+is $res->cookie('foo')->value, 'bar', 'right value';
+is $res->cookie('foo')->path, '/test', 'right path';
# Parse WebSocket handshake response
$res = Mojo::Message::Response->new;
@@ -1580,20 +1597,20 @@ $res->parse("Sec-WebSocket-Origin: http://example.com\x0d\x0a");
$res->parse("Sec-WebSocket-Location: ws://example.com/demo\x0d\x0a");
$res->parse("Sec-WebSocket-Protocol: sample\x0d\x0a\x0d\x0a");
$res->parse('8jKS\'y:G*Co,Wxa-');
-ok($req->is_done, 'request is done');
-is($res->code, 101, 'right status');
-is($res->message, 'WebSocket Protocol Handshake', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-is($res->headers->upgrade, 'WebSocket', 'right "Upgrade" value');
-is($res->headers->connection, 'Upgrade', 'right "Connection" value');
-is($res->headers->sec_websocket_origin,
- 'http://example.com', 'right "Sec-WebSocket-Origin" value');
-is($res->headers->sec_websocket_location,
- 'ws://example.com/demo', 'right "Sec-WebSocket-Location" value');
-is($res->headers->sec_websocket_protocol,
- 'sample', 'right "Sec-WebSocket-Protocol" value');
-is($res->body, '8jKS\'y:G*Co,Wxa-', 'right content');
+ok $req->is_done, 'request is done';
+is $res->code, 101, 'right status';
+is $res->message, 'WebSocket Protocol Handshake', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->upgrade, 'WebSocket', 'right "Upgrade" value';
+is $res->headers->connection, 'Upgrade', 'right "Connection" value';
+is $res->headers->sec_websocket_origin, 'http://example.com',
+ 'right "Sec-WebSocket-Origin" value';
+is $res->headers->sec_websocket_location, 'ws://example.com/demo',
+ 'right "Sec-WebSocket-Location" value';
+is $res->headers->sec_websocket_protocol, 'sample',
+ 'right "Sec-WebSocket-Protocol" value';
+is $res->body, '8jKS\'y:G*Co,Wxa-', 'right content';
# Build WebSocket handshake response
$res = Mojo::Message::Response->new;
@@ -1606,23 +1623,22 @@ $res->headers->sec_websocket_location('ws://example.com/demo');
$res->headers->sec_websocket_protocol('sample');
$res->body('8jKS\'y:G*Co,Wxa-');
$res = Mojo::Message::Response->new->parse($res->build);
-ok($res->is_done, 'request is done');
-is($res->code, '101', 'right status');
-is($res->message, 'WebSocket Protocol Handshake', 'right message');
-is($res->major_version, 1, 'right major version');
-is($res->minor_version, 1, 'right minor version');
-is($res->headers->connection, 'Upgrade', 'right "Connection" value');
-is($res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT',
- 'right "Date" value');
-is($res->headers->upgrade, 'WebSocket', 'right "Upgrade" value');
-is($res->headers->content_length, '16', 'right "Content-Length" value');
-is($res->headers->sec_websocket_origin,
- 'http://example.com', 'right "Sec-WebSocket-Origin" value');
-is($res->headers->sec_websocket_location,
- 'ws://example.com/demo', 'right "Sec-WebSocket-Location" value');
-is($res->headers->sec_websocket_protocol,
- 'sample', 'right "Sec-WebSocket-Protocol" value');
-is($res->body, '8jKS\'y:G*Co,Wxa-', 'right content');
+ok $res->is_done, 'request is done';
+is $res->code, '101', 'right status';
+is $res->message, 'WebSocket Protocol Handshake', 'right message';
+is $res->major_version, 1, 'right major version';
+is $res->minor_version, 1, 'right minor version';
+is $res->headers->connection, 'Upgrade', 'right "Connection" value';
+is $res->headers->date, 'Sun, 17 Aug 2008 16:27:35 GMT', 'right "Date" value';
+is $res->headers->upgrade, 'WebSocket', 'right "Upgrade" value';
+is $res->headers->content_length, '16', 'right "Content-Length" value';
+is $res->headers->sec_websocket_origin, 'http://example.com',
+ 'right "Sec-WebSocket-Origin" value';
+is $res->headers->sec_websocket_location,
+ 'ws://example.com/demo', 'right "Sec-WebSocket-Location" value';
+is $res->headers->sec_websocket_protocol,
+ 'sample', 'right "Sec-WebSocket-Protocol" value';
+is $res->body, '8jKS\'y:G*Co,Wxa-', 'right content';
# Build and parse HTTP 1.1 response with 3 cookies
$res = Mojo::Message::Response->new;
@@ -1639,49 +1655,52 @@ $res->headers->set_cookie2(
path => '/foobar'
)
);
-ok(!!$res->build, 'message built');
+ok !!$res->build, 'message built';
my $res2 = Mojo::Message::Response->new;
$res2->parse($res->build);
-ok($res2->is_done, 'response is done');
-is($res2->code, 404, 'right status');
-is($res2->major_version, 1, 'right major version');
-is($res2->minor_version, 1, 'right minor version');
-is($res2->headers->content_length, undef, 'right "Content-Length" value');
-is(defined $res2->cookie('foo'), 1, 'right value');
-is(defined $res2->cookie('baz'), 1, 'right value');
-is(defined $res2->cookie('bar'), 1, 'right value');
-is($res2->cookie('foo')->path, '/foobar', 'right path');
-is($res2->cookie('foo')->value, 'bar', 'right value');
-is($res2->cookie('baz')->path, '/foobar', 'right path');
-is($res2->cookie('baz')->value, 'yada', 'right value');
-is($res2->cookie('bar')->path, '/test/23', 'right path');
-is($res2->cookie('bar')->value, 'baz', 'right value');
+ok $res2->is_done, 'response is done';
+is $res2->code, 404, 'right status';
+is $res2->major_version, 1, 'right major version';
+is $res2->minor_version, 1, 'right minor version';
+is $res2->headers->content_length, 0, 'right "Content-Length" value';
+is defined $res2->cookie('foo'), 1, 'right value';
+is defined $res2->cookie('baz'), 1, 'right value';
+is defined $res2->cookie('bar'), 1, 'right value';
+is $res2->cookie('foo')->path, '/foobar', 'right path';
+is $res2->cookie('foo')->value, 'bar', 'right value';
+is $res2->cookie('baz')->path, '/foobar', 'right path';
+is $res2->cookie('baz')->value, 'yada', 'right value';
+is $res2->cookie('bar')->path, '/test/23', 'right path';
+is $res2->cookie('bar')->value, 'baz', 'right value';
# Build response with callback (make sure its called)
$res = Mojo::Message::Response->new;
$res->code(200);
$res->headers->content_length(10);
-$res->body(sub { die "Body coderef was called properly\n" });
-eval { $res->get_body_chunk(0) };
-is($@, "Body coderef was called properly\n", 'right error');
+$res->write('lala', sub { die "Body coderef was called properly\n" });
+$res->get_body_chunk(0);
+eval { $res->get_body_chunk(3) };
+is $@, "Body coderef was called properly\n", 'right error';
# Build response with callback (consistency calls)
$res = Mojo::Message::Response->new;
my $body = 'I is here';
$res->headers->content_length(length($body));
-$res->body(sub { return substr($body, $_[1], 1) });
+my $cb;
+$cb = sub { shift->write(substr($body, pop, 1), $cb) };
+$res->write('', $cb);
my $full = '';
my $count = 0;
my $offset = 0;
while (1) {
my $chunk = $res->get_body_chunk($offset);
- last unless length($chunk);
+ last unless defined $chunk;
$full .= $chunk;
$offset = length($full);
$count++;
}
-is($count, length($body), 'right length');
-is($full, $body, 'right content');
+is $count, length($body), 'right length';
+is $full, $body, 'right content';
# Build full HTTP 1.1 request with cookies
$req = Mojo::Message::Request->new;
@@ -1703,35 +1722,34 @@ $req->cookies(
)
);
$req->body("Hello World!\n");
-ok(!!$req->build, 'message built');
+ok !!$req->build, 'message built';
my $req2 = Mojo::Message::Request->new;
$req2->parse($req->build);
-ok($req2->is_done, 'request is done');
-is($req2->method, 'GET', 'right method');
-is($req2->major_version, 1, 'right major version');
-is($req2->minor_version, 1, 'right minor version');
-is($req2->headers->expect, '100-continue', 'right "Expect" value');
-is($req2->headers->host, '127.0.0.1', 'right "Host" value');
-is($req2->headers->content_length, 13, 'right "Content-Length" value');
-is( $req2->headers->cookie,
- '$Version=1; foo=bar; $Path=/foobar; bar=baz; $Path=/test/23',
- 'right "Cookie" value'
-);
-is($req2->url, '/foo/bar', 'right URL');
-is($req2->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL');
-is(defined $req2->cookie('foo'), 1, 'right value');
-is(defined $req2->cookie('baz'), '', 'no value');
-is(defined $req2->cookie('bar'), 1, 'right value');
-is($req2->cookie('foo')->path, '/foobar', 'right path');
-is($req2->cookie('foo')->value, 'bar', 'right value');
-is($req2->cookie('bar')->path, '/test/23', 'right path');
-is($req2->cookie('bar')->value, 'baz', 'right value');
-is($req2->body, "Hello World!\n", 'right content');
+ok $req2->is_done, 'request is done';
+is $req2->method, 'GET', 'right method';
+is $req2->major_version, 1, 'right major version';
+is $req2->minor_version, 1, 'right minor version';
+is $req2->headers->expect, '100-continue', 'right "Expect" value';
+is $req2->headers->host, '127.0.0.1', 'right "Host" value';
+is $req2->headers->content_length, 13, 'right "Content-Length" value';
+is $req2->headers->cookie,
+ '$Version=1; foo=bar; $Path=/foobar; bar=baz; $Path=/test/23',
+ 'right "Cookie" value';
+is $req2->url, '/foo/bar', 'right URL';
+is $req2->url->to_abs, 'http://127.0.0.1/foo/bar', 'right absolute URL';
+is defined $req2->cookie('foo'), 1, 'right value';
+is defined $req2->cookie('baz'), '', 'no value';
+is defined $req2->cookie('bar'), 1, 'right value';
+is $req2->cookie('foo')->path, '/foobar', 'right path';
+is $req2->cookie('foo')->value, 'bar', 'right value';
+is $req2->cookie('bar')->path, '/test/23', 'right path';
+is $req2->cookie('bar')->value, 'baz', 'right value';
+is $req2->body, "Hello World!\n", 'right content';
# Parse full HTTP 1.0 request with cookies
-$req = Mojo::Message::Request->new;
-$counter = 0;
-$req->progress_cb(sub { $counter++ });
+$req = Mojo::Message::Request->new;
+my $counter = 0;
+$req->on_progress(sub { $counter++ });
$req->parse('GET /foo/bar/baz.html?fo');
$req->parse("o=13#23 HTTP/1.0\x0d\x0aContent");
$req->parse('-Type: text/');
@@ -1740,23 +1758,23 @@ $req->parse('Cookie: $Version=1; foo=bar; $Path=/foobar; bar=baz; $Path=/t');
$req->parse("est/23\x0d\x0a");
$req->parse("Content-Length: 27\x0d\x0a\x0d\x0aHell");
$req->parse("o World!\n1234\nlalalala\n");
-is($counter, 8, 'right count');
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/foo/bar/baz.html?foo=13#23', 'right URL');
-is($req->headers->content_type, 'text/plain', 'right "Content-Type" value');
-is($req->headers->content_length, 27, 'right "Content-Length" value');
+is $counter, 8, 'right count';
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/foo/bar/baz.html?foo=13#23', 'right URL';
+is $req->headers->content_type, 'text/plain', 'right "Content-Type" value';
+is $req->headers->content_length, 27, 'right "Content-Length" value';
$cookies = $req->cookies;
-is($cookies->[0]->name, 'foo', 'right name');
-is($cookies->[0]->value, 'bar', 'right value');
-is($cookies->[0]->version, 1, 'right version');
-is($cookies->[0]->path, '/foobar', 'right path');
-is($cookies->[1]->name, 'bar', 'right name');
-is($cookies->[1]->value, 'baz', 'right value');
-is($cookies->[1]->version, 1, 'right version');
-is($cookies->[1]->path, '/test/23', 'right path');
+is $cookies->[0]->name, 'foo', 'right name';
+is $cookies->[0]->value, 'bar', 'right value';
+is $cookies->[0]->version, 1, 'right version';
+is $cookies->[0]->path, '/foobar', 'right path';
+is $cookies->[1]->name, 'bar', 'right name';
+is $cookies->[1]->value, 'baz', 'right value';
+is $cookies->[1]->version, 1, 'right version';
+is $cookies->[1]->path, '/test/23', 'right path';
# WebKit multipart/form-data request
$req = Mojo::Message::Request->new;
@@ -1774,8 +1792,8 @@ $req->parse("POST /example/testform_handler HTTP/1.1\x0d\x0a"
. "\x0aContent-Disposition: form-data; name=\"Text\"\x0d\x0a"
. "\x0d\x0a\x0d\x0a------WebKitFormBoundaryi5BnD9J9zoTMiSuP--"
. "\x0d\x0a");
-ok($req->is_done, 'request is done');
-is_deeply($req->param('Vorname'), 'T', 'right value');
+ok $req->is_done, 'request is done';
+is_deeply $req->param('Vorname'), 'T', 'right value';
# Google Chrome multipart/form-data request
$req = Mojo::Message::Request->new;
@@ -1821,30 +1839,27 @@ $req->parse("POST / HTTP/1.0\x0d\x0a"
. "Content-Disposition: form-data; name=\"submit\"\x0d\x0a\x0d\x0a"
. "Сохранить"
. "\x0d\x0a------WebKitFormBoundaryYGjwdkpB6ZLCZQbX--\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/', 'right URL');
-is( $req->cookie('mojolicious')->value,
- 'BAcIMTIzNDU2NzgECAgIAwIAAAAXDGFsZXgudm9yb25vdgQAAAB1c2VyBp6FjksAAAAABwA'
- . 'AAGV4cGlyZXM=--1641adddfe885276cda0deb7475f153a',
- 'right value'
-);
-like($req->headers->content_type,
- qr/multipart\/form-data/, 'right "Content-Type" value');
-is($req->param('fname'), 'Иван', 'right value');
-is($req->param('sname'), 'Иванов', 'right value');
-is($req->param('sex'), 'мужской', 'right value');
-is($req->param('bdate'), '16.02.1987', 'right value');
-is($req->param('phone'), '1234567890', 'right value');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/', 'right URL';
+is $req->cookie('mojolicious')->value,
+ 'BAcIMTIzNDU2NzgECAgIAwIAAAAXDGFsZXgudm9yb25vdgQAAAB1c2VyBp6FjksAAAAABwA'
+ . 'AAGV4cGlyZXM=--1641adddfe885276cda0deb7475f153a', 'right value';
+like $req->headers->content_type, qr/multipart\/form-data/,
+ 'right "Content-Type" value';
+is $req->param('fname'), 'Иван', 'right value';
+is $req->param('sname'), 'Иванов', 'right value';
+is $req->param('sex'), 'мужской', 'right value';
+is $req->param('bdate'), '16.02.1987', 'right value';
+is $req->param('phone'), '1234567890', 'right value';
my $upload = $req->upload('avatar');
-is($upload->isa('Mojo::Upload'), 1, 'right upload');
-is($upload->headers->content_type, 'image/jpeg',
- 'right "Content-Type" value');
-is($upload->filename, 'аватар.jpg', 'right filename');
-is($upload->size, 4, 'right size');
-is($upload->slurp, '1234', 'right content');
+is $upload->isa('Mojo::Upload'), 1, 'right upload';
+is $upload->headers->content_type, 'image/jpeg', 'right "Content-Type" value';
+is $upload->filename, 'аватар.jpg', 'right filename';
+is $upload->size, 4, 'right size';
+is $upload->slurp, '1234', 'right content';
# Firefox multipart/form-data request
$req = Mojo::Message::Request->new;
@@ -1895,30 +1910,27 @@ $req->parse("POST / HTTP/1.0\x0d\x0a"
. "Сохранить"
. "\x0d\x0a-----------------------------2130907227147213000020304999"
. "22--");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/', 'right URL');
-is( $req->cookie('mojolicious')->value,
- 'BAcIMTIzNDU2NzgECAgIAwIAAAAXDGFsZXgudm9yb25vdgQAAAB1c2VyBiWFjksAAAAABwA'
- . 'AAGV4cGlyZXM=--cd933a37999e0fa8d7804205e89193a7',
- 'right value'
-);
-like($req->headers->content_type,
- qr/multipart\/form-data/, 'right "Content-Type" value');
-is($req->param('fname'), 'Иван', 'right value');
-is($req->param('sname'), 'Иванов', 'right value');
-is($req->param('sex'), 'мужской', 'right value');
-is($req->param('bdate'), '16.02.1987', 'right value');
-is($req->param('phone'), '1234567890', 'right value');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/', 'right URL';
+is $req->cookie('mojolicious')->value,
+ 'BAcIMTIzNDU2NzgECAgIAwIAAAAXDGFsZXgudm9yb25vdgQAAAB1c2VyBiWFjksAAAAABwA'
+ . 'AAGV4cGlyZXM=--cd933a37999e0fa8d7804205e89193a7', 'right value';
+like $req->headers->content_type, qr/multipart\/form-data/,
+ 'right "Content-Type" value';
+is $req->param('fname'), 'Иван', 'right value';
+is $req->param('sname'), 'Иванов', 'right value';
+is $req->param('sex'), 'мужской', 'right value';
+is $req->param('bdate'), '16.02.1987', 'right value';
+is $req->param('phone'), '1234567890', 'right value';
$upload = $req->upload('avatar');
-is($upload->isa('Mojo::Upload'), 1, 'right upload');
-is($upload->headers->content_type, 'image/jpeg',
- 'right "Content-Type" value');
-is($upload->filename, 'аватар.jpg', 'right filename');
-is($upload->size, 4, 'right size');
-is($upload->slurp, '1234', 'right content');
+is $upload->isa('Mojo::Upload'), 1, 'right upload';
+is $upload->headers->content_type, 'image/jpeg', 'right "Content-Type" value';
+is $upload->filename, 'аватар.jpg', 'right filename';
+is $upload->size, 4, 'right size';
+is $upload->slurp, '1234', 'right content';
# Opera multipart/form-data request
$req = Mojo::Message::Request->new;
@@ -1964,91 +1976,88 @@ $req->parse("POST / HTTP/1.0\x0d\x0a"
. "Content-Disposition: form-data; name=\"submit\"\x0d\x0a\x0d\x0a"
. "Сохранить"
. "\x0d\x0a------------IWq9cR9mYYG668xwSn56f0--");
-ok($req->is_done, 'request is done');
-is($req->method, 'POST', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 0, 'right minor version');
-is($req->url, '/', 'right URL');
-is( $req->cookie('mojolicious')->value,
- 'BAcIMTIzNDU2NzgECAgIAwIAAAAXDGFsZXgudm9yb25vdgQAAAB1c2VyBhaIjksAAAAABwA'
- . 'AAGV4cGlyZXM=--78a58a94f98ae5b75a489be1189f2672',
- 'right value'
-);
-like($req->headers->content_type,
- qr/multipart\/form-data/, 'right "Content-Type" value');
-is($req->param('fname'), 'Иван', 'right value');
-is($req->param('sname'), 'Иванов', 'right value');
-is($req->param('sex'), 'мужской', 'right value');
-is($req->param('bdate'), '16.02.1987', 'right value');
-is($req->param('phone'), '1234567890', 'right value');
+ok $req->is_done, 'request is done';
+is $req->method, 'POST', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 0, 'right minor version';
+is $req->url, '/', 'right URL';
+is $req->cookie('mojolicious')->value,
+ 'BAcIMTIzNDU2NzgECAgIAwIAAAAXDGFsZXgudm9yb25vdgQAAAB1c2VyBhaIjksAAAAABwA'
+ . 'AAGV4cGlyZXM=--78a58a94f98ae5b75a489be1189f2672', 'right value';
+like $req->headers->content_type, qr/multipart\/form-data/,
+ 'right "Content-Type" value';
+is $req->param('fname'), 'Иван', 'right value';
+is $req->param('sname'), 'Иванов', 'right value';
+is $req->param('sex'), 'мужской', 'right value';
+is $req->param('bdate'), '16.02.1987', 'right value';
+is $req->param('phone'), '1234567890', 'right value';
$upload = $req->upload('avatar');
-is($upload->isa('Mojo::Upload'), 1, 'right upload');
-is($upload->headers->content_type, 'image/jpeg',
- 'right "Content-Type" value');
-is($upload->filename, 'аватар.jpg', 'right filename');
-is($upload->size, 4, 'right size');
-is($upload->slurp, '1234', 'right content');
+is $upload->isa('Mojo::Upload'), 1, 'right upload';
+is $upload->headers->content_type, 'image/jpeg', 'right "Content-Type" value';
+is $upload->filename, 'аватар.jpg', 'right filename';
+is $upload->size, 4, 'right size';
+is $upload->slurp, '1234', 'right content';
# Parse ~ in URL
$req = Mojo::Message::Request->new;
$req->parse("GET /~foobar/ HTTP/1.1\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/~foobar/', 'right URL');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/~foobar/', 'right URL';
# Parse : in URL
$req = Mojo::Message::Request->new;
$req->parse("GET /perldoc?Mojo::Message::Request HTTP/1.1\x0d\x0a\x0d\x0a");
-ok($req->is_done, 'request is done');
-is($req->method, 'GET', 'right method');
-is($req->major_version, 1, 'right major version');
-is($req->minor_version, 1, 'right minor version');
-is($req->url, '/perldoc?Mojo::Message::Request', 'right URL');
+ok $req->is_done, 'request is done';
+is $req->method, 'GET', 'right method';
+is $req->major_version, 1, 'right major version';
+is $req->minor_version, 1, 'right minor version';
+is $req->url, '/perldoc?Mojo::Message::Request', 'right URL';
# Body helper
$req = Mojo::Message::Request->new;
$req->body('hi there!');
-is($req->body, 'hi there!', 'right content');
+is $req->body, 'hi there!', 'right content';
$req->body('');
-is($req->body, '', 'right content');
+is $req->body, '', 'right content';
$req->body('hi there!');
-is($req->body, 'hi there!', 'right content');
+is $req->body, 'hi there!', 'right content';
$req->body(undef);
-is($req->body, '', 'right content');
+is $req->body, '', 'right content';
$req->body(sub { });
-is(ref $req->body, 'CODE', 'body is callback');
+is ref $req->body, 'CODE', 'body is callback';
$req->body(undef);
-is($req->body, '', 'right content');
+is $req->body, '', 'right content';
$req->body(0);
-is($req->body, 0, 'right content');
+is $req->body, 0, 'right content';
$req->body(sub { });
-is(ref $req->body, 'CODE', 'body is callback');
+is ref $req->body, 'CODE', 'body is callback';
$req->body('hello!');
-is($req->body, 'hello!', 'right content');
-is($req->body_cb, undef, 'no body callback');
+is $req->body, 'hello!', 'right content';
+is $req->on_read, undef, 'no read callback';
$req->content(Mojo::Content::MultiPart->new);
$req->body('hi!');
-is($req->body, 'hi!', 'right content');
+is $req->body, 'hi!', 'right content';
# Version management
my $m = Mojo::Message->new;
-is($m->major_version, 1, 'major_version defaults to 1');
-is($m->minor_version, 1, 'minor_version defaults to 1');
-ok($m->at_least_version('1.1'), '1.1 passes at_least_version("1.1")');
-ok($m->at_least_version('1.0'), '1.1 passes at_least_version("1.0")');
+is $m->major_version, 1, 'major_version defaults to 1';
+is $m->minor_version, 1, 'minor_version defaults to 1';
+ok $m->at_least_version('1.1'), '1.1 passes at_least_version("1.1")';
+ok $m->at_least_version('1.0'), '1.1 passes at_least_version("1.0")';
$m = Mojo::Message->new(minor_version => 0);
-is($m->minor_version, 0, 'minor_version set to 0');
-ok(!$m->at_least_version('1.1'), '1.0 fails at_least_version("1.1")');
-ok($m->at_least_version('1.0'), '1.0 passes at_least_version("1.0")');
+is $m->minor_version, 0, 'minor_version set to 0';
+ok !$m->at_least_version('1.1'), '1.0 fails at_least_version("1.1")';
+ok $m->at_least_version('1.0'), '1.0 passes at_least_version("1.0")';
$m = Mojo::Message->new(major_version => 0, minor_version => 9);
-ok(!$m->at_least_version('1.0'), '0.9 fails at_least_version("1.0")');
-ok($m->at_least_version('0.9'), '0.9 passes at_least_version("0.9")');
+ok !$m->at_least_version('1.0'), '0.9 fails at_least_version("1.0")';
+ok $m->at_least_version('0.9'), '0.9 passes at_least_version("0.9")';
# "headers" chaining
$req = Mojo::Message::Request->new->headers(Mojo::Headers->new);
-is($req->isa('Mojo::Message::Request'), 1, 'right request');
+is $req->isa('Mojo::Message::Request'), 1, 'right request';
# Build dom from request with charset
$res = Mojo::Message::Response->new;
@@ -2056,11 +2065,12 @@ $res->parse("HTTP/1.1 200 OK\x0a");
$res->parse(
"Content-Type: application/atom+xml; charset=UTF-8; type=feed\x0a");
$res->parse("\x0a");
-$res->body('<test>Test</test>');
-ok($res->is_done, 'request is done');
-is( $res->headers->content_type,
- 'application/atom+xml; charset=UTF-8; type=feed',
- 'right "Content-Type" value'
-);
-ok($res->dom, 'dom built');
-
+$res->body('<p>foo <a href="/">bar</a><a href="/baz">baz</a></p>');
+ok $res->is_done, 'request is done';
+is $res->headers->content_type,
+ 'application/atom+xml; charset=UTF-8; type=feed',
+ 'right "Content-Type" value';
+ok $res->dom, 'dom built';
+$count = 0;
+$res->dom('a')->each(sub { $count++ });
+is $count, 2, 'all anchors found';
@@ -3,110 +3,114 @@
use strict;
use warnings;
-use Test::More tests => 39;
+use utf8;
+
+use Test::More tests => 42;
# Now that's a wave of destruction that's easy on the eyes.
-use_ok('Mojo::Parameters');
+use_ok 'Mojo::Parameters';
# Basics with custom pair separator
my $params = Mojo::Parameters->new('foo=b%3Bar&baz=23');
my $params2 = Mojo::Parameters->new('x', 1, 'y', 2);
-is($params->pair_separator, '&', 'right pair separator');
-is($params->to_string, 'foo=b%3Bar&baz=23', 'right format');
-is($params2->to_string, 'x=1&y=2', 'right format');
+is $params->pair_separator, '&', 'right pair separator';
+is $params->to_string, 'foo=b%3Bar&baz=23', 'right format';
+is $params2->to_string, 'x=1&y=2', 'right format';
$params->pair_separator(';');
-is($params->to_string, 'foo=b%3Bar;baz=23', 'right format');
-is("$params", 'foo=b%3Bar;baz=23', 'right format');
+is $params->to_string, 'foo=b%3Bar;baz=23', 'right format';
+is "$params", 'foo=b%3Bar;baz=23', 'right format';
# Append
-is_deeply($params->params, ['foo', 'b;ar', 'baz', 23], 'right structure');
+is_deeply $params->params, ['foo', 'b;ar', 'baz', 23], 'right structure';
$params->append('a', 4, 'a', 5, 'b', 6, 'b', 7);
-is($params->to_string, "foo=b%3Bar;baz=23;a=4;a=5;b=6;b=7", 'right format');
+is $params->to_string, "foo=b%3Bar;baz=23;a=4;a=5;b=6;b=7", 'right format';
# Clone
my $clone = $params->clone;
-is("$params", "$clone", 'equal results');
+is "$params", "$clone", 'equal results';
# Merge
$params->merge($params2);
-is($params->to_string, 'foo=b%3Bar;baz=23;a=4;a=5;b=6;b=7;x=1;y=2',
- 'right format');
-is($params2->to_string, 'x=1&y=2', 'right format');
+is $params->to_string, 'foo=b%3Bar;baz=23;a=4;a=5;b=6;b=7;x=1;y=2',
+ 'right format';
+is $params2->to_string, 'x=1&y=2', 'right format';
# Param
-is_deeply($params->param('foo'), 'b;ar', 'right structure');
-is_deeply([$params->param('a')], [4, 5], 'right structure');
+is_deeply $params->param('foo'), 'b;ar', 'right structure';
+is_deeply [$params->param('a')], [4, 5], 'right structure';
# Parse with ";" separator
$params->parse('q=1;w=2;e=3;e=4;r=6;t=7');
-is($params->to_string, 'q=1;w=2;e=3;e=4;r=6;t=7', 'right format');
+is $params->to_string, 'q=1;w=2;e=3;e=4;r=6;t=7', 'right format';
# Remove
$params->remove('r');
-is($params->to_string, 'q=1;w=2;e=3;e=4;t=7', 'right format');
+is $params->to_string, 'q=1;w=2;e=3;e=4;t=7', 'right format';
$params->remove('e');
-is($params->to_string, 'q=1;w=2;t=7', 'right format');
+is $params->to_string, 'q=1;w=2;t=7', 'right format';
# Hash
-is_deeply($params->to_hash, {q => 1, w => 2, t => 7}, 'right structure');
+is_deeply $params->to_hash, {q => 1, w => 2, t => 7}, 'right structure';
# List names
-is_deeply([$params->param], [qw/q t w/], 'right structure');
+is_deeply [$params->param], [qw/q t w/], 'right structure';
# Append
$params->append('a', 4, 'a', 5, 'b', 6, 'b', 7);
-is_deeply(
- $params->to_hash,
- {a => [4, 5], b => [6, 7], q => 1, w => 2, t => 7},
- 'right structure'
-);
+is_deeply $params->to_hash,
+ {a => [4, 5], b => [6, 7], q => 1, w => 2, t => 7}, 'right structure';
# 0 value
$params = Mojo::Parameters->new(foo => 0);
-is_deeply($params->param('foo'), 0, 'right structure');
-is($params->to_string, 'foo=0', 'right format');
+is_deeply $params->param('foo'), 0, 'right structure';
+is $params->to_string, 'foo=0', 'right format';
$params = Mojo::Parameters->new($params->to_string);
-is_deeply($params->param('foo'), 0, 'right structure');
-is($params->to_string, 'foo=0', 'right format');
+is_deeply $params->param('foo'), 0, 'right structure';
+is $params->to_string, 'foo=0', 'right format';
# Reconstruction
$params = Mojo::Parameters->new('foo=bar&baz=23');
-is("$params", 'foo=bar&baz=23', 'right format');
+is "$params", 'foo=bar&baz=23', 'right format';
$params = Mojo::Parameters->new('foo=bar;baz=23');
-is("$params", 'foo=bar;baz=23', 'right format');
+is "$params", 'foo=bar;baz=23', 'right format';
# Undefined params
$params = Mojo::Parameters->new;
$params->append('c', undef);
$params->append(undef, 'c');
$params->append(undef, undef);
-is($params->to_string, "c=&=c&=", 'right format');
-is_deeply($params->to_hash, {c => '', '' => ['c', '']}, 'right structure');
+is $params->to_string, "c=&=c&=", 'right format';
+is_deeply $params->to_hash, {c => '', '' => ['c', '']}, 'right structure';
$params->remove('c');
-is($params->to_string, "=c&=", 'right format');
+is $params->to_string, "=c&=", 'right format';
$params->remove(undef);
-ok((not defined $params->to_string), 'empty');
+ok !defined $params->to_string, 'empty';
# +
$params = Mojo::Parameters->new('foo=%2B');
-is($params->param('foo'), '+', 'right value');
-is_deeply($params->to_hash, {foo => '+'}, 'right structure');
+is $params->param('foo'), '+', 'right value';
+is_deeply $params->to_hash, {foo => '+'}, 'right structure';
$params->param('foo ' => 'a');
-is($params->to_string, "foo=%2B&foo+=a", 'right format');
+is $params->to_string, "foo=%2B&foo+=a", 'right format';
$params->remove('foo ');
-is_deeply($params->to_hash, {foo => '+'}, 'right structure');
+is_deeply $params->to_hash, {foo => '+'}, 'right structure';
$params->append('1 2', '3+3');
-is($params->param('1 2'), '3+3', 'right value');
-is_deeply($params->to_hash, {foo => '+', '1 2' => '3+3'}, 'right structure');
+is $params->param('1 2'), '3+3', 'right value';
+is_deeply $params->to_hash, {foo => '+', '1 2' => '3+3'}, 'right structure';
# Array values
$params = Mojo::Parameters->new;
$params->append(foo => [qw/bar baz/], a => 'b', bar => [qw/bas test/]);
-is_deeply([$params->param('foo')], [qw/bar baz/], 'right values');
-is($params->param('a'), 'b', 'right value');
-is_deeply([$params->param('bar')], [qw/bas test/], 'right values');
-is_deeply(
- $params->to_hash,
- {foo => ['bar', 'baz'], a => 'b', bar => ['bas', 'test']},
- 'right structure'
-);
+is_deeply [$params->param('foo')], [qw/bar baz/], 'right values';
+is $params->param('a'), 'b', 'right value';
+is_deeply [$params->param('bar')], [qw/bas test/], 'right values';
+is_deeply $params->to_hash,
+ {foo => ['bar', 'baz'], a => 'b', bar => ['bas', 'test']},
+ 'right structure';
+
+# Unicode
+$params = Mojo::Parameters->new;
+$params->parse('input=say%20%22%C2%AB%22;');
+is $params->params->[1], 'say "«"', 'right value';
+is $params->param('input'), 'say "«"', 'right value';
+is "$params", 'input=say+%22%C2%AB%22', 'right result';
@@ -7,8 +7,8 @@ use Test::More tests => 3;
# This is the greatest case of false advertising I’ve seen since I sued the
# movie “The Never Ending Story.”
-use_ok('Mojo::Path');
+use_ok 'Mojo::Path';
my $path = Mojo::Path->new;
-is($path->parse('/path')->to_string, '/path', 'right path');
-is($path->parse('/path/0')->to_string, '/path/0', 'right path');
+is $path->parse('/path')->to_string, '/path', 'right path';
+is $path->parse('/path/0')->to_string, '/path/0', 'right path';
@@ -8,8 +8,8 @@ use Test::More tests => 15;
use Mojo::JSON;
# We need some more secret sauce. Put the mayonnaise in the sun.
-use_ok('Mojo::Server::PSGI');
-use_ok('Mojo::Command::Psgi');
+use_ok 'Mojo::Server::PSGI';
+use_ok 'Mojo::Command::Psgi';
# Binding
my $psgi = Mojo::Server::PSGI->new;
@@ -34,21 +34,21 @@ my $env = {
'psgi.run_once' => 0
};
my $res = $app->($env);
-is($res->[0], 200, 'right status');
+is $res->[0], 200, 'right status';
my %headers = @{$res->[1]};
-is(keys %headers, 3, 'right number of headers');
-ok($headers{Date}, 'right "Date" value');
-is($headers{'Content-Length'}, '41', 'right "Content-Length" value');
-is($headers{'Content-Type'}, 'application/json',
- 'right "Content-Type" value');
+is keys(%headers), 3, 'right number of headers';
+ok $headers{Date}, 'right "Date" value';
+is $headers{'Content-Length'}, 41, 'right "Content-Length" value';
+is $headers{'Content-Type'}, 'application/json', 'right "Content-Type" value';
my $params = '';
while (defined(my $chunk = $res->[2]->getline)) { $params .= $chunk }
$params = Mojo::JSON->new->decode($params);
-is_deeply(
- $params,
- {bar => 'baz', hello => 'world', lalala => 23},
- 'right structure'
-);
+is_deeply $params,
+ { bar => 'baz',
+ hello => 'world',
+ lalala => 23
+ },
+ 'right structure';
# Command
$content = 'world=hello';
@@ -72,19 +72,19 @@ $env = {
};
$app = Mojo::Command::Psgi->new->run;
$res = $app->($env);
-is($res->[0], 200, 'right status');
+is $res->[0], 200, 'right status';
%headers = @{$res->[1]};
-is(keys %headers, 3, 'right number of headers');
-ok($headers{Date}, 'right "Date" value');
-is($headers{'Content-Length'}, '41', 'right "Content-Length" value');
-is($headers{'Content-Type'}, 'application/json',
- 'right "Content-Type" value');
+is keys(%headers), 3, 'right number of headers';
+ok $headers{Date}, 'right "Date" value';
+is $headers{'Content-Length'}, 41, 'right "Content-Length" value';
+is $headers{'Content-Type'}, 'application/json', 'right "Content-Type" value';
$params = '';
while (defined(my $chunk = $res->[2]->getline)) { $params .= $chunk }
$params = Mojo::JSON->new->decode($params);
-is_deeply(
- $params,
- {bar => 'baz', world => 'hello', lalala => 23},
- 'right structure'
-);
-is($ENV{MOJO_HELLO}, 'world', 'finished callback');
+is_deeply $params,
+ { bar => 'baz',
+ world => 'hello',
+ lalala => 23
+ },
+ 'right structure';
+is $ENV{MOJO_HELLO}, 'world', 'on_finish callback';
@@ -14,22 +14,22 @@ use base 'Mojo';
package main;
-use_ok('Mojo::Server');
+use_ok 'Mojo::Server';
my $server = Mojo::Server->new;
-isa_ok($server, 'Mojo::Server', 'right object');
+isa_ok $server, 'Mojo::Server', 'right object';
# Test the default
my $app = $server->new->app;
-isa_ok($app, 'Mojo::HelloWorld', 'right default app');
+isa_ok $app, 'Mojo::HelloWorld', 'right default app';
# Test an explicit class name
$app = $server->new(app_class => 'Mojo::TestServerViaApp')->app;
-isa_ok($app, 'Mojo::TestServerViaApp', 'right object');
+isa_ok $app, 'Mojo::TestServerViaApp', 'right object';
# Test setting the class name through the environment
my $backup = $ENV{MOJO_APP} || '';
$ENV{MOJO_APP} = 'Mojo::TestServerViaEnv';
$app = $server->new->app;
-isa_ok($app, 'Mojo::TestServerViaEnv', 'right object');
+isa_ok $app, 'Mojo::TestServerViaEnv', 'right object';
$ENV{MOJO_APP} = $backup;
@@ -23,7 +23,7 @@ package main;
use strict;
use warnings;
-use Test::More tests => 95;
+use Test::More tests => 114;
use File::Spec;
use File::Temp;
@@ -31,188 +31,416 @@ use FindBin;
# When I held that gun in my hand, I felt a surge of power...
# like God must feel when he's holding a gun.
-use_ok('Mojo::Template');
+use_ok 'Mojo::Template';
# Trim line
my $mt = Mojo::Template->new;
my $output = $mt->render(" <%= 'test' =%> \n");
-is($output, 'test', 'line trimmed');
+is $output, 'test', 'line trimmed';
# Trim line (with expression)
$mt = Mojo::Template->new;
$output = $mt->render("<%= '123' %><%= 'test' =%>\n");
-is($output, '123test', 'expression trimmed');
+is $output, '123test', 'expression trimmed';
# Trim lines
$mt = Mojo::Template->new;
$output = $mt->render(" foo \n <%= 'test' =%>\n foo\n");
-is($output, " footestfoo\n", 'lines trimmed');
+is $output, " footestfoo\n", 'lines trimmed';
# Trim lines (at start of line)
$mt = Mojo::Template->new;
$output = $mt->render(" \n<%= 'test' =%>\n ");
-is($output, 'test', 'lines at start trimmed');
+is $output, 'test', 'lines at start trimmed';
# Trim lines (multiple lines)
$mt = Mojo::Template->new;
$output = $mt->render(" bar\n foo\n <%= 'test' =%>\n foo\n bar\n");
-is($output, " bar\n footestfoo\n bar\n", 'multiple lines trimmed');
+is $output, " bar\n footestfoo\n bar\n", 'multiple lines trimmed';
# Trim lines (multiple empty lines)
$mt = Mojo::Template->new;
$output = $mt->render(" \n<%= 'test' =%>\n ");
-is($output, 'test', 'multiple empty lines trimmed');
+is $output, 'test', 'multiple empty lines trimmed';
# Trim expression tags
$mt = Mojo::Template->new;
-$output = $mt->render(' <%{= block =%><html><%} =%> ');
-is($output, '<html>', 'expression tags trimmed');
+$output = $mt->render(' <%= block begin =%><html><% end =%> ');
+is $output, '<html>', 'expression tags trimmed';
-# Expression block
+# Trim expression tags (relaxed expression end)
+$mt = Mojo::Template->new;
+$output = $mt->render(' <%= block begin =%><html><%= end =%> ');
+is $output, '<html>', 'expression tags trimmed';
+
+# Trim expression tags (relaxed escaped expression end)
+$mt = Mojo::Template->new;
+$output = $mt->render(' <%= block begin =%><html><%== end =%> ');
+is $output, '<html>', 'expression tags trimmed';
+
+# Recursive block
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-%{ my $block =
+% my $block;
+<% $block = begin =%>
+% my $i = shift;
<html>
-%}
-%= $block->()
+<%= $block->(--$i) if $i %>
+<% end =%>
+<%= $block->(2) %>
EOF
-is($output, "<html>\n", 'expression block');
+is $output, "<html>\n<html>\n<html>\n\n", 'recursive block';
-# Escaped expression block
+# Recursive block (perl lines)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-%{ my $block =
+% my $block;
+% $block = begin
+% my $i = shift;
<html>
-%}
-%== $block->()
+%= $block->(--$i) if $i
+% end
+%= $block->(2)
EOF
-is($output, "<html>\n", 'escaped expression block');
+is $output, "<html>\n<html>\n<html>\n\n\n\n\n", 'recursive block';
-# Captured escaped expression block
+# Recursive block (indented perl lines)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-%{== my $result = block
+ % my $block;
+ % $block = begin
+ % my $i = shift;
<html>
-%}
-%= $result
+ <%= $block->(--$i) if $i =%>
+ % end
+ %= $block->(2)
+EOF
+is $output, " <html><html><html>\n", 'recursive block';
+
+# Expression block (less whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+<% my $block =begin=%>
+<html>
+<%end=%>
+<%= $block->() %>
+EOF
+is $output, "<html>\n", 'expression block';
+
+# Expression block (perl lines and less whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+% my $block =begin
+<html>
+%end
+<%= $block->() %>
+EOF
+is $output, "<html>\n\n", 'expression block';
+
+# Expression block (indented perl lines and less whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+ % my $block =begin
+<html>
+ %end
+<%= $block->() %>
EOF
-is($output, "<html>\n<html>\n", 'captured escaped expression block');
+is $output, "<html>\n\n", 'expression block';
-# Capture lines
+# Escaped expression block (extra whitespace)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-%{ my $result = escape block
+<% my $block = begin %>
<html>
-%}
+<% end %>
+<%== $block->() %>
+EOF
+is $output, "\n\n<html>\n\n", 'escaped expression block';
+
+# Escaped expression block (perl lines and extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+% my $block = begin
+<html>
+<% end %>
+<%== $block->() %>
+EOF
+is $output, "\n<html>\n\n", 'escaped expression block';
+
+# Escaped expression block (indented perl lines and extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+ % my $block = begin
+<html>
+ % end
+<%== $block->() %>
+EOF
+is $output, "<html>\n\n", 'escaped expression block';
+
+# Captured escaped expression block (extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+<%== my $result = block begin =%>
+<html>
+<% end =%>
+<%= $result =%>
+EOF
+is $output, '<html><html>', 'captured escaped expression block';
+
+# Captured escaped expression block (perl lines and extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+%== my $result = block begin
+<html>
+% end
+<%= $result =%>
+EOF
+is $output, <<EOF, 'captured escaped expression block';
+
+<html>
+
+<html>
+EOF
+
+# Captured escaped expression block (indented perl lines and extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+%== my $result = block begin
+<html>
+ % end
+<%= $result =%>
+EOF
+is $output, <<EOF, 'captured escaped expression block';
+
+<html>
+
+<html>
+EOF
+
+# Capture lines (extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+<% my $result = escape block begin %>
+<html>
+<% end %>
%= $result
EOF
-is($output, "<html>\n", 'captured lines');
+is $output, "\n\n<html>\n\n", 'captured lines';
# Capture tags
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<%{ my $result = escape block%><html><%}%><%= $result %>
+<% my $result = escape block begin %><html><% end %><%= $result %>
EOF
-is($output, "<html>\n", 'capture tags');
+is $output, "<html>\n", 'capture tags';
# Capture tags (alternative)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<% my $result = escape block {%><html><%}%><%= $result %>
+<% my $result = escape block begin %><html><% end %><%= $result %>
EOF
-is($output, "<html>\n", 'capture tags');
+is $output, "<html>\n", 'capture tags';
# Capture tags with appended code
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<%{ my $result = escape( block %><html><%} ); %><%= $result %>
+<% my $result = escape( block begin %><html><% end ); %><%= $result %>
EOF
-is($output, "<html>\n", 'capture tags with appended code');
+is $output, "<html>\n", 'capture tags with appended code';
# Capture tags with appended code (alternative)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<% my $result = escape( block {%><html><%} ); %><%= $result %>
+<% my $result = escape( block begin %><html><% end ); %><%= $result %>
EOF
-is($output, "<html>\n", 'capture tags with appended code');
+is $output, "<html>\n", 'capture tags with appended code';
# Nested capture tags
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<%{ my $result = block %><%{= escape block %><html><%}%><%}%><%= $result %>
+<% my $result = block
+ begin %><%= escape block begin %><html><% end
+ %><% end %><%= $result %>
EOF
-is($output, "<html>\n", 'nested capture tags');
+is $output, "<html>\n", 'nested capture tags';
# Nested capture tags (alternative)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<% my $result = block {%><%= escape block {%><html><%}%><%}%><%= $result %>
+<% my $result = block begin =%>
+ <%= escape block begin =%>
+ <html>
+ <% end =%>
+<% end =%>
+<%= $result =%>
EOF
-is($output, "<html>\n", 'nested capture tags');
+is $output, '<html>', 'nested capture tags';
-# Advanced capturing
+# Advanced capturing (extra whitespace)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-%{ my $block =
-% my $name = shift;
+<% my $block = begin =%>
+<% my $name = shift; =%>
Hello <%= $name %>.
-%}
-%= $block->('Baerbel')
-%= $block->('Wolfgang')
+<% end =%>
+<%= $block->('Baerbel') %>
+<%= $block->('Wolfgang') %>
EOF
-is($output, <<EOF, 'advanced capturing');
+is $output, <<EOF, 'advanced capturing';
Hello Baerbel.
Hello Wolfgang.
EOF
+# Advanced capturing (perl lines extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+% my $block = begin
+<% my $name = shift; =%>
+Hello <%= $name %>.
+% end
+<%= $block->('Baerbel') %>
+<%= $block->('Wolfgang') %>
+EOF
+is $output, <<EOF, 'advanced capturing';
+Hello Baerbel.
+
+Hello Wolfgang.
+
+EOF
+
+# Advanced capturing (indented perl lines extra whitespace)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+ % my $block = begin
+<% my $name = shift; =%>
+Hello <%= $name %>.
+ % end
+<%= $block->('Baerbel') %>
+<%= $block->('Wolfgang') %>
+EOF
+is $output, <<EOF, 'advanced capturing';
+Hello Baerbel.
+
+Hello Wolfgang.
+
+EOF
+
# Advanced capturing with tags
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<%{ my $block = =%>
+<% my $block = begin =%>
<% my $name = shift; =%>
Hello <%= $name %>.
-<%}=%>
+<% end =%>
<%= $block->('Sebastian') %>
<%= $block->('Sara') %>
EOF
-is($output, <<EOF, 'advanced capturing with tags');
+is $output, <<EOF, 'advanced capturing with tags';
Hello Sebastian.
Hello Sara.
EOF
+# Advanced capturing with tags (perl lines)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+% my $block = begin
+ <% my $name = shift; =%>
+ Hello <%= $name %>.
+% end
+%= $block->('Sebastian')
+%= $block->('Sara')
+EOF
+is $output, <<EOF, 'advanced capturing with tags';
+Hello Sebastian.
+
+Hello Sara.
+
+EOF
+
+# Advanced capturing with tags (indented perl lines)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+% my $block = begin
+ % my $name = shift;
+ Hello <%= $name %>.
+% end
+ %= $block->('Sebastian')
+%= $block->('Sara')
+EOF
+is $output, <<EOF, 'advanced capturing with tags';
+ Hello Sebastian.
+
+ Hello Sara.
+
+EOF
+
# Advanced capturing with tags (alternative)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
-<% my $block = ={%>
+<% my $block = begin =%>
<% my $name = shift; =%>
Hello <%= $name %>.
-<%}=%>
+<% end =%>
<%= $block->('Sebastian') %>
<%= $block->('Sara') %>
EOF
-is($output, <<EOF, 'advanced capturing with tags');
+is $output, <<EOF, 'advanced capturing with tags';
+Hello Sebastian.
+Hello Sara.
+EOF
+
+# Advanced capturing with tags (perl lines and alternative)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+% my $block = begin
+ <% my $name = shift; =%>
+ Hello <%= $name %>.
+% end
+%= $block->('Sebastian')
+%= $block->('Sara')
+EOF
+is $output, <<EOF, 'advanced capturing with tags';
Hello Sebastian.
+
Hello Sara.
+
+EOF
+
+# Advanced capturing with tags (indented perl lines and alternative)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+ % my $block = begin
+ % my $name = shift;
+ Hello <%= $name %>.
+ % end
+%= $block->('Sebastian')
+%= $block->('Sara')
+EOF
+is $output, <<EOF, 'advanced capturing with tags';
+ Hello Sebastian.
+
+ Hello Sara.
+
EOF
# More advanced capturing with tags (alternative)
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
<% my
-$block1 = ={%>
+$block1 = begin =%>
<% my $name = shift; =%>
Hello <%= $name %>.
-<%}=%>
+<% end =%>
<% my
$block2 =
-={%>
+begin =%>
<% my $name = shift; =%>
Bye <%= $name %>.
-<%}=%>
+<% end =%>
<%= $block1->('Sebastian') %>
<%= $block2->('Sara') %>
EOF
-is($output, <<EOF, 'advanced capturing with tags');
+is $output, <<EOF, 'advanced capturing with tags';
Hello Sebastian.
Bye Sara.
EOF
@@ -221,11 +449,11 @@ EOF
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
% my $i = 2;
-<%{= block %>
+<%= block begin %>
<%= $i++ %>
-<%} for 1 .. 3; %>
+<% end for 1 .. 3; %>
EOF
-is($output, <<EOF, 'block loop');
+is $output, <<EOF, 'block loop';
2
@@ -235,13 +463,33 @@ is($output, <<EOF, 'block loop');
EOF
+# Block loop (perl lines)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+% my $i = 2;
+%= block begin
+ <%= $i++ =%>
+% end for 1 .. 3;
+EOF
+is $output, '234', 'block loop';
+
+# Block loop (indented perl lines)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+ % my $i = 2;
+ %= block begin
+ %= $i++
+ % end for 1 .. 3;
+EOF
+is $output, " \n 2\n\n 3\n\n 4\n", 'block loop';
+
# Strict
$mt = Mojo::Template->new;
$output = $mt->render(<<'EOF');
% $foo = 1;
EOF
-is(ref $output, 'Mojo::Exception', 'right exception');
-like($output->message, qr/^Global symbol "\$foo" requires/, 'right message');
+is ref $output, 'Mojo::Exception', 'right exception';
+like $output->message, qr/^Global symbol "\$foo" requires/, 'right message';
# Importing into a template
$mt = Mojo::Template->new;
@@ -250,13 +498,13 @@ $output = $mt->render(<<'EOF');
%= __PACKAGE__
%= foo
EOF
-is($output, 'Mojo::Templateworks!', 'right result');
+is $output, "Mojo::Template\nworks!\n", 'right result';
$output = $mt->render(<<'EOF');
% BEGIN { MyTemplateExporter->import }
%= __PACKAGE__
%= foo
EOF
-is($output, 'Mojo::Templateworks!', 'right result');
+is $output, "Mojo::Template\nworks!\n", 'right result';
# Compile time exception
$mt = Mojo::Template->new;
@@ -267,21 +515,17 @@ test
%= 1 + 1
test
EOF
-is(ref $output, 'Mojo::Exception', 'right exception');
-like(
- $output->message,
- qr/^Missing right curly or square bracket/,
- 'right message'
-);
-like($output->message, qr/syntax error at template line 5.$/,
- 'right message');
-is($output->lines_before->[0]->[0], 3, 'right number');
-is($output->lines_before->[0]->[1], '% {', 'right line');
-is($output->lines_before->[1]->[0], 4, 'right number');
-is($output->lines_before->[1]->[1], '%= 1 + 1', 'right line');
-is($output->line->[0], 5, 'right number');
-is($output->line->[1], 'test', 'right line');
-like("$output", qr/^Missing right curly or square bracket/, 'right result');
+is ref $output, 'Mojo::Exception', 'right exception';
+like $output->message, qr/^Missing right curly or square bracket/,
+ 'right message';
+like $output->message, qr/syntax error at template line 5.$/, 'right message';
+is $output->lines_before->[0]->[0], 3, 'right number';
+is $output->lines_before->[0]->[1], '% {', 'right line';
+is $output->lines_before->[1]->[0], 4, 'right number';
+is $output->lines_before->[1]->[1], '%= 1 + 1', 'right line';
+is $output->line->[0], 5, 'right number';
+is $output->line->[1], 'test', 'right line';
+like "$output", qr/^Missing right curly or square bracket/, 'right result';
# Exception in module
$mt = Mojo::Template->new;
@@ -292,19 +536,19 @@ test
%= 1 + 1
test
EOF
-is(ref $output, 'Mojo::Exception', 'right exception');
-like($output->message, qr/ohoh/, 'right message');
-is($output->lines_before->[0]->[0], 17, 'right number');
-is($output->lines_before->[0]->[1], 'use warnings;', 'right line');
-is($output->lines_before->[1]->[0], 18, 'right number');
-is($output->lines_before->[1]->[1], '', 'right line');
-is($output->line->[0], 19, 'right number');
-is($output->line->[1], "sub exception { die 'ohoh' }", 'right line');
-is($output->lines_after->[0]->[0], 20, 'right number');
-is($output->lines_after->[0]->[1], '', 'right line');
-is($output->lines_after->[1]->[0], 21, 'right number');
-is($output->lines_after->[1]->[1], 'package main;', 'right line');
-like("$output", qr/ohoh/, 'right result');
+is ref $output, 'Mojo::Exception', 'right exception';
+like $output->message, qr/ohoh/, 'right message';
+is $output->lines_before->[0]->[0], 17, 'right number';
+is $output->lines_before->[0]->[1], 'use warnings;', 'right line';
+is $output->lines_before->[1]->[0], 18, 'right number';
+is $output->lines_before->[1]->[1], '', 'right line';
+is $output->line->[0], 19, 'right number';
+is $output->line->[1], "sub exception { die 'ohoh' }", 'right line';
+is $output->lines_after->[0]->[0], 20, 'right number';
+is $output->lines_after->[0]->[1], '', 'right line';
+is $output->lines_after->[1]->[0], 21, 'right number';
+is $output->lines_after->[1]->[1], 'package main;', 'right line';
+like "$output", qr/ohoh/, 'right result';
# Exception in template
$mt = Mojo::Template->new;
@@ -315,20 +559,20 @@ test
%= 1 + 1
test
EOF
-is(ref $output, 'Mojo::Exception', 'right exception');
-like($output->message, qr/oops\!/, 'right message');
-is($output->lines_before->[0]->[0], 1, 'right number');
-is($output->lines_before->[0]->[1], 'test', 'right line');
-is($output->lines_before->[1]->[0], 2, 'right number');
-is($output->lines_before->[1]->[1], '123', 'right line');
-is($output->line->[0], 3, 'right number');
-is($output->line->[1], "% die 'oops!';", 'right line');
-is($output->lines_after->[0]->[0], 4, 'right number');
-is($output->lines_after->[0]->[1], '%= 1 + 1', 'right line');
-is($output->lines_after->[1]->[0], 5, 'right number');
-is($output->lines_after->[1]->[1], 'test', 'right line');
-like("$output", qr/oops\! at template line 3, near "%= 1 \+ 1"./,
- 'right result');
+is ref $output, 'Mojo::Exception', 'right exception';
+like $output->message, qr/oops\!/, 'right message';
+is $output->lines_before->[0]->[0], 1, 'right number';
+is $output->lines_before->[0]->[1], 'test', 'right line';
+is $output->lines_before->[1]->[0], 2, 'right number';
+is $output->lines_before->[1]->[1], '123', 'right line';
+is $output->line->[0], 3, 'right number';
+is $output->line->[1], "% die 'oops!';", 'right line';
+is $output->lines_after->[0]->[0], 4, 'right number';
+is $output->lines_after->[0]->[1], '%= 1 + 1', 'right line';
+is $output->lines_after->[1]->[0], 5, 'right number';
+is $output->lines_after->[1]->[1], 'test', 'right line';
+like "$output", qr/oops\! at template line 3, near "%= 1 \+ 1"./,
+ 'right result';
# Exception in nested template
$mt = Mojo::Template->new;
@@ -344,11 +588,12 @@ EOT
$-= $output
-$]
EOF
-is($output, <<'EOF', 'exception in nested template');
+is $output, <<'EOF', 'exception in nested template';
test
Bareword "bar" not allowed while "strict subs" in use at template line 1.
1: %= bar
+
EOF
# Control structures
@@ -367,7 +612,7 @@ bar
foo
% }
EOF
-is($output, "foo\nbar\n", 'control structure');
+is $output, "foo\nbar\n", 'control structure';
# All tags
$mt = Mojo::Template->new;
@@ -380,14 +625,14 @@ $mt->parse(<<'EOF');
</html>
EOF
$mt->build;
-like($mt->code, qr/^package /, 'right code');
-like($mt->code, qr/lala/, 'right code');
-unlike($mt->code, qr/ comment lalala /, 'right code');
-ok(!defined($mt->compiled), 'nothing compiled');
+like $mt->code, qr/^package /, 'right code';
+like $mt->code, qr/lala/, 'right code';
+unlike $mt->code, qr/ comment lalala /, 'right code';
+ok !defined($mt->compiled), 'nothing compiled';
$mt->compile;
-is(ref($mt->compiled), 'CODE', 'code compiled');
+is ref($mt->compiled), 'CODE', 'code compiled';
$output = $mt->interpret(2);
-is($output, "<html foo=\"bar\">\n3 test 4 lala \n4\</html>\n", 'all tags');
+is $output, "<html foo=\"bar\">\n3 test 4 lala \n4\n\</html>\n", 'all tags';
# Arguments
$mt = Mojo::Template->new;
@@ -397,7 +642,7 @@ $output = $mt->render(<<'EOF', 'test', {foo => 'bar'});
%= $message . ' ' . $hash->{foo}
</html>
EOF
-is($output, "<html>\ntest bar</html>\n", 'arguments');
+is $output, "<html>\ntest bar\n</html>\n", 'arguments';
# Ugly multiline loop
$mt = Mojo::Template->new;
@@ -407,7 +652,7 @@ $output = $mt->render(<<'EOF');
$nums .= "$i";
} %><%= $nums%></html>
EOF
-is($output, "<html>1234</html>\n", 'ugly multiline loop');
+is $output, "<html>1234</html>\n", 'ugly multiline loop';
# Clean multiline loop
$mt = Mojo::Template->new;
@@ -418,7 +663,7 @@ $output = $mt->render(<<'EOF');
% }
</html>
EOF
-is($output, "<html>\n1234</html>\n", 'clean multiline loop');
+is $output, "<html>\n1\n2\n3\n4\n</html>\n", 'clean multiline loop';
# Escaped line ending
$mt = Mojo::Template->new;
@@ -427,7 +672,7 @@ $output = $mt->render(<<'EOF');
%= '2' x 4
</html>\\\\
EOF
-is($output, "<html>2222</html>\\\\\\\n", 'escaped line ending');
+is $output, "<html>2222\n</html>\\\\\\\n", 'escaped line ending';
# XML escape
$mt = Mojo::Template->new;
@@ -436,7 +681,7 @@ $output = $mt->render(<<'EOF');
%== '<'
</html>
EOF
-is($output, "<html><html>\n&lt;</html>\n", 'XML escape');
+is $output, "<html><html>\n&lt;\n</html>\n", 'XML escape';
# XML auto escape
$mt = Mojo::Template->new;
@@ -447,7 +692,12 @@ $output = $mt->render(<<'EOF');
%== '<'
</html>
EOF
-is($output, "<html><html>\n&lt;<</html>\n", 'XML auto escape');
+is $output, <<EOF, 'XML auto escape';
+<html><html>
+&lt;
+<
+</html>
+EOF
# Complicated XML auto escape
$mt = Mojo::Template->new;
@@ -456,10 +706,11 @@ $output = $mt->render(<<'EOF', {foo => 23});
% use Data::Dumper;
%= Data::Dumper->new([shift])->Maxdepth(2)->Indent(1)->Terse(1)->Dump
EOF
-is($output, <<'EOF', 'complicated XML auto escape');
+is $output, <<'EOF', 'complicated XML auto escape';
{
- 'foo' => 23
+ 'foo' => 23
}
+
EOF
# Complicated XML auto escape
@@ -468,10 +719,9 @@ $mt->auto_escape(1);
$output = $mt->render(<<'EOF');
<html><%= '<html>' for 1 .. 3 %></html>
EOF
-is( $output,
- "<html><html><html><html></html>\n",
- 'complicated XML auto escape'
-);
+is $output, <<EOF, 'complicated XML auto escape';
+<html><html><html><html></html>
+EOF
# Prepending code
$mt = Mojo::Template->new;
@@ -482,20 +732,20 @@ $output = $mt->render(<<'EOF', 23);
% my $bar = 23;
%= $bar
EOF
-is($output, "23\nsomething\nelse23", 'prepending code');
+is $output, "23\nsomething\nelse\n23\n", 'prepending code';
$mt = Mojo::Template->new;
$mt->prepend(
q/{no warnings 'redefine'; no strict 'refs'; *foo = sub { 23 }}/);
$output = $mt->render('<%= foo() %>');
-is($output, "23\n", 'right result');
+is $output, "23\n", 'right result';
$output = $mt->render('%= foo()');
-is($output, 23, 'right result');
+is $output, "23\n", 'right result';
# Appending code
$mt = Mojo::Template->new;
$mt->append('$_M = "FOO!"');
$output = $mt->render('23');
-is($output, "FOO!", 'appending code');
+is $output, "FOO!", 'appending code';
# Multiline comment
$mt = Mojo::Template->new;
@@ -508,12 +758,12 @@ comment %>this not
% }
</html>
EOF
-is($output, "<html>this not\n1234</html>\n", 'multiline comment');
+is $output, "<html>this not\n1\n2\n3\n4\n</html>\n", 'multiline comment';
# Oneliner
$mt = Mojo::Template->new;
$output = $mt->render('<html><%= 3 * 3 %></html>\\');
-is($output, '<html>9</html>', 'oneliner');
+is $output, '<html>9</html>', 'oneliner';
# Different line start
$mt = Mojo::Template->new;
@@ -523,7 +773,7 @@ $output = $mt->render(<<'EOF');
$= '2' x 4
</html>\\\\
EOF
-is($output, "<html>2222</html>\\\\\\\n", 'different line start');
+is $output, "<html>2222\n</html>\\\\\\\n", 'different line start';
# Multiline expression
$mt = Mojo::Template->new;
@@ -532,7 +782,7 @@ $output = $mt->render(<<'EOF');
$i x 4; }; %>\
</html>\
EOF
-is($output, '<html>2222</html>', 'multiline expression');
+is $output, '<html>2222</html>', 'multiline expression';
# Different multiline expression
$mt = Mojo::Template->new;
@@ -541,7 +791,7 @@ $output = $mt->render(<<'EOF');
$i x 4; };
%>\
EOF
-is($output, '2222', 'multiline expression');
+is $output, '2222', 'multiline expression';
# Scoped scalar
$mt = Mojo::Template->new;
@@ -549,7 +799,7 @@ $output = $mt->render(<<'EOF');
% my $foo = 'bar';
<%= $foo %>
EOF
-is($output, "bar\n", 'scoped scalar');
+is $output, "bar\n", 'scoped scalar';
# Different tags and line start
$mt = Mojo::Template->new;
@@ -562,7 +812,7 @@ $- my $message = shift;
$-= $message . ' ' . $hash->{foo}
</html>
EOF
-is($output, "<html>\ntest bar</html>\n", 'different tags and line start');
+is $output, "<html>\ntest bar\n</html>\n", 'different tags and line start';
# Different expression and comment marks
$mt = Mojo::Template->new;
@@ -574,17 +824,18 @@ $output = $mt->render(<<'EOF', 'test', {foo => 'bar'});
%--- $message . ' ' . $hash->{foo}
</html>
EOF
-is( $output,
- "<html>\ntest bar</html>\n",
- 'different expression and comment mark'
-);
+is $output, <<EOF, 'different expression and comment mark';
+<html>
+test bar
+</html>
+EOF
# File
$mt = Mojo::Template->new;
my $file =
File::Spec->catfile(File::Spec->splitdir($FindBin::Bin), qw/lib test.mt/);
$output = $mt->render_file($file, 3);
-like($output, qr/23Hello World!/, 'file');
+like $output, qr/23\nHello World!/, 'file';
# File to file with utf8 data
$mt = Mojo::Template->new;
@@ -592,14 +843,14 @@ $mt->tag_start('[$-');
$mt->tag_end('-$]');
my $dir = File::Temp::tempdir(CLEANUP => 1);
$file = File::Spec->catfile($dir, 'test.mt');
-is($mt->render_to_file(<<"EOF", $file), undef, 'file rendered');
+is $mt->render_to_file(<<"EOF", $file), undef, 'file rendered';
<% my \$i = 23; %> foo bar
\x{df}\x{0100}bar\x{263a} <%= \$i %>
test
EOF
$mt = Mojo::Template->new;
my $file2 = File::Spec->catfile($dir, 'test2.mt');
-is($mt->render_file_to_file($file, $file2), undef, 'file rendered to file');
+is $mt->render_file_to_file($file, $file2), undef, 'file rendered to file';
$mt = Mojo::Template->new;
$output = $mt->render_file($file2);
-is($output, " foo bar\n\x{df}\x{0100}bar\x{263a} 23\ntest\n", 'right result');
+is $output, " foo bar\n\x{df}\x{0100}bar\x{263a} 23\ntest\n", 'right result';
@@ -5,238 +5,294 @@ use warnings;
use utf8;
-use Test::More tests => 113;
+use Test::More tests => 154;
# I don't want you driving around in a car you built yourself.
# You can sit there complaining, or you can knit me some seat belts.
-use_ok('Mojo::URL');
+use_ok 'Mojo::URL';
# Simple
my $url = Mojo::URL->new('HtTp://Kraih.Com');
-is($url->scheme, 'HtTp', 'right scheme');
-is($url->host, 'Kraih.Com', 'right host');
-is("$url", 'http://kraih.com', 'right format');
+is $url->scheme, 'HtTp', 'right scheme';
+is $url->host, 'Kraih.Com', 'right host';
+is "$url", 'http://kraih.com', 'right format';
# Advanced
$url = Mojo::URL->new(
'http://sri:foobar@kraih.com:8080/test/index.html?monkey=biz&foo=1#23');
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->userinfo, 'sri:foobar', 'right userinfo');
-is($url->host, 'kraih.com', 'right host');
-is($url->port, '8080', 'right port');
-is($url->path, '/test/index.html', 'right path');
-is($url->query, 'monkey=biz&foo=1', 'right query');
-is($url->fragment, '23', 'right fragment');
-is("$url",
- 'http://sri:foobar@kraih.com:8080/test/index.html?monkey=biz&foo=1#23',
- 'right format');
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->userinfo, 'sri:foobar', 'right userinfo';
+is $url->host, 'kraih.com', 'right host';
+is $url->port, '8080', 'right port';
+is $url->path, '/test/index.html', 'right path';
+is $url->query, 'monkey=biz&foo=1', 'right query';
+is $url->fragment, '23', 'right fragment';
+is "$url",
+ 'http://sri:foobar@kraih.com:8080/test/index.html?monkey=biz&foo=1#23',
+ 'right format';
$url->path('/index.xml');
-is("$url", 'http://sri:foobar@kraih.com:8080/index.xml?monkey=biz&foo=1#23',
- 'right format');
+is "$url", 'http://sri:foobar@kraih.com:8080/index.xml?monkey=biz&foo=1#23',
+ 'right format';
# Parameters
$url = Mojo::URL->new(
'http://sri:foobar@kraih.com:8080?_monkey=biz%3B&_monkey=23#23');
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->userinfo, 'sri:foobar', 'right userinfo');
-is($url->host, 'kraih.com', 'right host');
-is($url->port, '8080', 'right port');
-is($url->path, '', 'no path');
-is($url->query, '_monkey=biz%3B&_monkey=23', 'right query');
-is_deeply($url->query->to_hash, {_monkey => ['biz;', 23]}, 'right structure');
-is($url->fragment, '23', 'right fragment');
-is("$url", 'http://sri:foobar@kraih.com:8080?_monkey=biz%3B&_monkey=23#23',
- 'right format');
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->userinfo, 'sri:foobar', 'right userinfo';
+is $url->host, 'kraih.com', 'right host';
+is $url->port, '8080', 'right port';
+is $url->path, '', 'no path';
+is $url->query, '_monkey=biz%3B&_monkey=23', 'right query';
+is_deeply $url->query->to_hash, {_monkey => ['biz;', 23]}, 'right structure';
+is $url->fragment, '23', 'right fragment';
+is "$url", 'http://sri:foobar@kraih.com:8080?_monkey=biz%3B&_monkey=23#23',
+ 'right format';
$url->query(monkey => 'foo');
-is("$url", 'http://sri:foobar@kraih.com:8080?monkey=foo#23', 'right format');
+is "$url", 'http://sri:foobar@kraih.com:8080?monkey=foo#23', 'right format';
+$url->query({foo => 'bar'});
+is "$url", 'http://sri:foobar@kraih.com:8080?monkey=foo&foo=bar#23',
+ 'right format';
$url->query('foo');
-is("$url", 'http://sri:foobar@kraih.com:8080?foo#23', 'right format');
+is "$url", 'http://sri:foobar@kraih.com:8080?foo#23', 'right format';
$url->query('foo=bar');
-is("$url", 'http://sri:foobar@kraih.com:8080?foo%3Dbar#23', 'right format');
+is "$url", 'http://sri:foobar@kraih.com:8080?foo%3Dbar#23', 'right format';
# Query string
$url = Mojo::URL->new(
'http://sri:foobar@kraih.com:8080?_monkeybiz%3B&_monkey;23#23');
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->userinfo, 'sri:foobar', 'right userinfo');
-is($url->host, 'kraih.com', 'right host');
-is($url->port, '8080', 'right port');
-is($url->path, '', 'no path');
-is($url->query, '_monkeybiz%3B%26_monkey%3B23', 'right query');
-is_deeply(
- $url->query->params,
- ['_monkeybiz;&_monkey;23', undef],
- 'right structure'
-);
-is($url->fragment, '23', 'right fragment');
-is("$url", 'http://sri:foobar@kraih.com:8080?_monkeybiz%3B%26_monkey%3B23#23',
- 'right format');
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->userinfo, 'sri:foobar', 'right userinfo';
+is $url->host, 'kraih.com', 'right host';
+is $url->port, '8080', 'right port';
+is $url->path, '', 'no path';
+is $url->query, '_monkeybiz%3B%26_monkey%3B23', 'right query';
+is_deeply $url->query->params, ['_monkeybiz;&_monkey;23', undef],
+ 'right structure';
+is $url->fragment, '23', 'right fragment';
+is "$url", 'http://sri:foobar@kraih.com:8080?_monkeybiz%3B%26_monkey%3B23#23',
+ 'right format';
# Relative
$url = Mojo::URL->new('http://sri:foobar@kraih.com:8080/foo?foo=bar#23');
$url->base->parse('http://sri:foobar@kraih.com:8080/');
-is($url->is_abs, 1, 'is absolute');
-is($url->to_rel, '/foo?foo=bar#23', 'right relative version');
+is $url->is_abs, 1, 'is absolute';
+is $url->to_rel, '/foo?foo=bar#23', 'right relative version';
# Relative with path
$url = Mojo::URL->new('http://kraih.com/foo/index.html?foo=bar#23');
$url->base->parse('http://kraih.com/foo/');
my $rel = $url->to_rel;
-is($rel, 'index.html?foo=bar#23', 'right format');
-is($rel->is_abs, undef, 'not absolute');
-is( $rel->to_abs,
- 'http://kraih.com/foo/index.html?foo=bar#23',
- 'right absolute version'
-);
+is $rel, 'index.html?foo=bar#23', 'right format';
+is $rel->is_abs, undef, 'not absolute';
+is $rel->to_abs, 'http://kraih.com/foo/index.html?foo=bar#23',
+ 'right absolute version';
# Relative path
$url = Mojo::URL->new('http://kraih.com/foo/?foo=bar#23');
$url->path('bar');
-is("$url", 'http://kraih.com/foo/bar?foo=bar#23');
+is "$url", 'http://kraih.com/foo/bar?foo=bar#23', 'right path';
$url = Mojo::URL->new('http://kraih.com?foo=bar#23');
$url->path('bar');
-is("$url", 'http://kraih.com/bar?foo=bar#23');
+is "$url", 'http://kraih.com/bar?foo=bar#23', 'right path';
+$url = Mojo::URL->new('http://kraih.com/foo?foo=bar#23');
+$url->path('bar');
+is "$url", 'http://kraih.com/bar?foo=bar#23', 'right path';
+$url = Mojo::URL->new('http://kraih.com/foo/bar?foo=bar#23');
+$url->path('yada/baz');
+is "$url", 'http://kraih.com/foo/yada/baz?foo=bar#23', 'right path';
+$url = Mojo::URL->new('http://kraih.com/foo/bar?foo=bar#23');
+$url->path('../baz');
+is "$url", 'http://kraih.com/foo/../baz?foo=bar#23', 'right path';
+$url->path->canonicalize;
+is "$url", 'http://kraih.com/baz?foo=bar#23', 'right canonicalized path';
# Absolute (base without trailing slash)
$url = Mojo::URL->new('/foo?foo=bar#23');
$url->base->parse('http://kraih.com/bar');
-is($url->is_abs, undef, 'not absolute');
-is($url->to_abs, 'http://kraih.com/foo?foo=bar#23', 'right absolute version');
+is $url->is_abs, undef, 'not absolute';
+is $url->to_abs, 'http://kraih.com/foo?foo=bar#23', 'right absolute version';
# Absolute with path
$url = Mojo::URL->new('../foo?foo=bar#23');
$url->base->parse('http://kraih.com/bar/baz/');
-is($url->is_abs, undef, 'not absolute');
-is( $url->to_abs,
- 'http://kraih.com/bar/baz/../foo?foo=bar#23',
- 'right absolute version'
-);
-is($url->to_abs->to_rel, '../foo?foo=bar#23', 'right relative version');
-is($url->to_abs->base, 'http://kraih.com/bar/baz/', 'right base');
+is $url->is_abs, undef, 'not absolute';
+is $url->to_abs, 'http://kraih.com/bar/baz/../foo?foo=bar#23',
+ 'right absolute version';
+is $url->to_abs->to_rel, '../foo?foo=bar#23', 'right relative version';
+is $url->to_abs->base, 'http://kraih.com/bar/baz/', 'right base';
# Real world tests
$url = Mojo::URL->new('http://acme.s3.amazonaws.com'
. '/mojo%2Fg%2B%2B-4%2E2_4%2E2%2E3-2ubuntu7_i386%2Edeb');
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->userinfo, undef, 'no userinfo');
-is($url->host, 'acme.s3.amazonaws.com', 'right host');
-is($url->port, undef, 'no port');
-is($url->path, '/mojo%2Fg++-4.2_4.2.3-2ubuntu7_i386.deb', 'right path');
-ok(!$url->query, 'no query');
-is_deeply($url->query->to_hash, {}, 'right structure');
-is($url->fragment, undef, 'no fragment');
-is("$url",
- 'http://acme.s3.amazonaws.com/mojo%2Fg++-4.2_4.2.3-2ubuntu7_i386.deb',
- 'right format');
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->userinfo, undef, 'no userinfo';
+is $url->host, 'acme.s3.amazonaws.com', 'right host';
+is $url->port, undef, 'no port';
+is $url->path, '/mojo%2Fg++-4.2_4.2.3-2ubuntu7_i386.deb', 'right path';
+ok !$url->query, 'no query';
+is_deeply $url->query->to_hash, {}, 'right structure';
+is $url->fragment, undef, 'no fragment';
+is "$url",
+ 'http://acme.s3.amazonaws.com/mojo%2Fg++-4.2_4.2.3-2ubuntu7_i386.deb',
+ 'right format';
# Clone (advanced)
$url = Mojo::URL->new(
'http://sri:foobar@kraih.com:8080/test/index.html?monkey=biz&foo=1#23');
my $clone = $url->clone;
-is($clone->is_abs, 1, 'is absolute');
-is($clone->scheme, 'http', 'right scheme');
-is($clone->userinfo, 'sri:foobar', 'right userinfo');
-is($clone->host, 'kraih.com', 'right host');
-is($clone->port, '8080', 'right port');
-is($clone->path, '/test/index.html', 'right path');
-is($clone->query, 'monkey=biz&foo=1', 'right query');
-is($clone->fragment, '23', 'right fragment');
-is("$clone",
- 'http://sri:foobar@kraih.com:8080/test/index.html?monkey=biz&foo=1#23',
- 'right format');
+is $clone->is_abs, 1, 'is absolute';
+is $clone->scheme, 'http', 'right scheme';
+is $clone->userinfo, 'sri:foobar', 'right userinfo';
+is $clone->host, 'kraih.com', 'right host';
+is $clone->port, '8080', 'right port';
+is $clone->path, '/test/index.html', 'right path';
+is $clone->query, 'monkey=biz&foo=1', 'right query';
+is $clone->fragment, '23', 'right fragment';
+is "$clone",
+ 'http://sri:foobar@kraih.com:8080/test/index.html?monkey=biz&foo=1#23',
+ 'right format';
$clone->path('/index.xml');
-is("$clone", 'http://sri:foobar@kraih.com:8080/index.xml?monkey=biz&foo=1#23',
- 'right format');
+is "$clone", 'http://sri:foobar@kraih.com:8080/index.xml?monkey=biz&foo=1#23',
+ 'right format';
# Clone (with base)
$url = Mojo::URL->new('/test/index.html');
$url->base->parse('http://127.0.0.1');
-is("$url", '/test/index.html', 'right format');
+is "$url", '/test/index.html', 'right format';
$clone = $url->clone;
-is("$url", '/test/index.html', 'right format');
-is($clone->is_abs, undef, 'not absolute');
-is($clone->scheme, undef, 'no scheme');
-is($clone->host, undef, 'no host');
-is($clone->base->scheme, 'http', 'right base scheme');
-is($clone->base->host, '127.0.0.1', 'right base host');
-is($clone->path, '/test/index.html', 'right path');
-is( $clone->to_abs->to_string,
- 'http://127.0.0.1/test/index.html',
- 'right absolute version'
-);
+is "$url", '/test/index.html', 'right format';
+is $clone->is_abs, undef, 'not absolute';
+is $clone->scheme, undef, 'no scheme';
+is $clone->host, undef, 'no host';
+is $clone->base->scheme, 'http', 'right base scheme';
+is $clone->base->host, '127.0.0.1', 'right base host';
+is $clone->path, '/test/index.html', 'right path';
+is $clone->to_abs->to_string, 'http://127.0.0.1/test/index.html',
+ 'right absolute version';
# IPv6
$url = Mojo::URL->new('http://[::1]:3000/');
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->host, '[::1]', 'right host');
-is($url->port, 3000, 'right port');
-is($url->path, '/', 'right path');
-is("$url", 'http://[::1]:3000/', 'right format');
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->host, '[::1]', 'right host';
+is $url->port, 3000, 'right port';
+is $url->path, '/', 'right path';
+is "$url", 'http://[::1]:3000/', 'right format';
# IDNA
$url = Mojo::URL->new('http://bücher.ch:3000/foo');
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->host, 'bücher.ch', 'right host');
-is($url->ihost, 'xn--bcher-kva.ch', 'right internationalized host');
-is($url->port, 3000, 'right port');
-is($url->path, '/foo', 'right path');
-is("$url", 'http://xn--bcher-kva.ch:3000/foo', 'right format');
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->host, 'bücher.ch', 'right host';
+is $url->ihost, 'xn--bcher-kva.ch', 'right internationalized host';
+is $url->port, 3000, 'right port';
+is $url->path, '/foo', 'right path';
+is "$url", 'http://xn--bcher-kva.ch:3000/foo', 'right format';
# IDNA (snowman)
$url = Mojo::URL->new('http://☃.net/');
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->host, '☃.net', 'right host');
-is($url->ihost, 'xn--n3h.net', 'right internationalized host');
-is($url->path, '/', 'right path');
-is("$url", 'http://xn--n3h.net/', 'right format');
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->host, '☃.net', 'right host';
+is $url->ihost, 'xn--n3h.net', 'right internationalized host';
+is $url->path, '/', 'right path';
+is "$url", 'http://xn--n3h.net/', 'right format';
# Already absolute
$url = Mojo::URL->new('http://foo.com/');
-is($url->to_abs, 'http://foo.com/', 'right absolute version');
+is $url->to_abs, 'http://foo.com/', 'right absolute version';
# Already relative
$url = Mojo::URL->new('http://sri:foobar@kraih.com:8080/foo?foo=bar#23');
$url->base->parse('http://sri:foobar@kraih.com:8080/');
my $url2 = $url->to_rel;
-is($url->to_rel, '/foo?foo=bar#23', 'right relative version');
+is $url->to_rel, '/foo?foo=bar#23', 'right relative version';
# IRI
$url =
Mojo::URL->new('http://sharifulin.ru/привет/?q=шарифулин');
-is($url->path->parts->[0], 'привет', 'right path part');
-is($url->path, '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82/', 'right path');
-is($url->query, 'q=%D1%88%D0%B0%D1%80%D0%B8%D1%84%D1%83%D0%BB%D0%B8%D0%BD',
- 'right query');
-is($url->query->param('q'), 'шарифулин', 'right query value');
+is $url->path->parts->[0], 'привет', 'right path part';
+is $url->path, '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82/', 'right path';
+is $url->query, 'q=%D1%88%D0%B0%D1%80%D0%B8%D1%84%D1%83%D0%BB%D0%B8%D0%BD',
+ 'right query';
+is $url->query->param('q'), 'шарифулин', 'right query value';
# IRI/IDNA
$url = Mojo::URL->new(
'http://☃.net/привет/привет/?привет=шарифулин'
);
-is($url->is_abs, 1, 'is absolute');
-is($url->scheme, 'http', 'right scheme');
-is($url->host, '☃.net', 'right host');
-is($url->ihost, 'xn--n3h.net', 'right internationalized host');
-is( $url->path,
- '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82'
- . '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82/',
- 'right host'
-);
-is($url->path->parts->[0], 'привет', 'right path part');
-is($url->path->parts->[1], 'привет', 'right path part');
-is($url->query->param('привет'),
- 'шарифулин', 'right query value');
-is( "$url",
+is $url->is_abs, 1, 'is absolute';
+is $url->scheme, 'http', 'right scheme';
+is $url->host, '☃.net', 'right host';
+is $url->ihost, 'xn--n3h.net', 'right internationalized host';
+is $url->path, '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82'
+ . '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82/', 'right host';
+is $url->path->parts->[0], 'привет', 'right path part';
+is $url->path->parts->[1], 'привет', 'right path part';
+is $url->query->param('привет'), 'шарифулин',
+ 'right query value';
+is "$url",
'http://xn--n3h.net/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82'
- . '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82/'
- . '?%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82='
- . '%D1%88%D0%B0%D1%80%D0%B8%D1%84%D1%83%D0%BB%D0%B8%D0%BD',
- 'right format'
-);
+ . '/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82/'
+ . '?%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82='
+ . '%D1%88%D0%B0%D1%80%D0%B8%D1%84%D1%83%D0%BB%D0%B8%D0%BD', 'right format';
+
+# Empty path elements
+$url = Mojo::URL->new('http://kraih.com/foo//bar/23/');
+$url->base->parse('http://kraih.com/');
+is $url->is_abs, 1;
+is $url->to_rel, '/foo//bar/23/';
+$url = Mojo::URL->new('http://kraih.com//foo//bar/23/');
+$url->base->parse('http://kraih.com/');
+is $url->is_abs, 1;
+is $url->to_rel, '/foo//bar/23/';
+$url = Mojo::URL->new('http://kraih.com/foo///bar/23/');
+$url->base->parse('http://kraih.com/');
+is $url->is_abs, 1;
+is $url->to_rel, '/foo///bar/23/';
+
+# Check host for IPv4 and IPv6 addresses
+$url = Mojo::URL->new('http://mojolicio.us');
+is $url->host, 'mojolicio.us', 'right host';
+is $url->is_ipv4, undef, 'not an IPv4 address';
+is $url->is_ipv6, undef, 'not an IPv6 address';
+$url = Mojo::URL->new('http://[::1]');
+is $url->host, '[::1]', 'right host';
+is $url->is_ipv4, undef, 'not an IPv4 address';
+is $url->is_ipv6, 1, 'is an IPv6 address';
+$url = Mojo::URL->new('http://127.0.0.1');
+is $url->host, '127.0.0.1', 'right host';
+is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv6, undef, 'not an IPv6 address';
+$url = Mojo::URL->new('http://0::127.0.0.1');
+is $url->host, '0::127.0.0.1', 'right host';
+is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv6, 1, 'is an IPv6 address';
+$url = Mojo::URL->new('http://[0::127.0.0.1]');
+is $url->host, '[0::127.0.0.1]', 'right host';
+is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv6, 1, 'is an IPv6 address';
+$url = Mojo::URL->new('http://mojolicio.us:3000');
+is $url->host, 'mojolicio.us', 'right host';
+is $url->is_ipv4, undef, 'not an IPv4 address';
+is $url->is_ipv6, undef, 'not an IPv6 address';
+$url = Mojo::URL->new('http://[::1]:3000');
+is $url->host, '[::1]', 'right host';
+is $url->is_ipv4, undef, 'not an IPv4 address';
+is $url->is_ipv6, 1, 'is an IPv6 address';
+$url = Mojo::URL->new('http://127.0.0.1:3000');
+is $url->host, '127.0.0.1', 'right host';
+is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv6, undef, 'not an IPv6 address';
+$url = Mojo::URL->new('http://0::127.0.0.1:3000');
+is $url->host, '0::127.0.0.1', 'right host';
+is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv6, 1, 'is an IPv6 address';
+$url = Mojo::URL->new('http://[0::127.0.0.1]:3000');
+is $url->host, '[0::127.0.0.1]', 'right host';
+is $url->is_ipv4, 1, 'is an IPv4 address';
+is $url->is_ipv6, 1, 'is an IPv6 address';
@@ -6,13 +6,7 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 194;
+use Test::More tests => 194;
use FindBin;
use lib "$FindBin::Bin/lib";
@@ -26,7 +20,7 @@ use Mojolicious;
# Congratulations Fry, you've snagged the perfect girlfriend.
# Amy's rich, she's probably got other characteristics...
-use_ok('MojoliciousTest');
+use_ok 'MojoliciousTest';
my $t = Test::Mojo->new(app => 'MojoliciousTest');
@@ -36,13 +30,6 @@ $t->get_ok('/syntax_error/foo')->status_is(500)
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_like(qr/Missing right curly/);
-# Foo::exceptionduringpausedtransaction
-# (syntax error in controller during paused transaction)
-$t->get_ok('/foo/exceptionduringpausedtransaction')->status_is(500)
- ->header_is(Server => 'Mojolicious (Perl)')
- ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_like(qr/Exception/);
-
# Foo::syntaxerror (syntax error in template)
$t->get_ok('/foo/syntaxerror')->status_is(500)
->header_is(Server => 'Mojolicious (Perl)')
@@ -78,7 +65,7 @@ $t->get_ok('/foo/test', {'X-Test' => 'Hi there!'})->status_is(200)
$t->get_ok('/foo', {'X-Test' => 'Hi there!'})->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_like(qr/<body>\s+23Hello Mojo from the template \/foo! He/);
+ ->content_like(qr/<body>\s+23\nHello Mojo from the template \/foo! He/);
# Foo::Bar::index
$t->get_ok('/foo-bar', {'X-Test' => 'Hi there!'})->status_is(200)
@@ -177,11 +164,11 @@ $t->get_ok('/hello.txt', {'If-Modified-Since' => $mtime})->status_is(304)
# Check develpment mode log level
my $app = Mojolicious->new;
-is($app->log->level, 'debug', 'right log level');
+is $app->log->level, 'debug', 'right log level';
# Make sure we can override attributes with constructor arguments
$app = MojoliciousTest->new({mode => 'test'});
-is($app->mode, 'test', 'right mode');
+is $app->mode, 'test', 'right mode';
# Persistent error
$app = MojoliciousTest->new;
@@ -189,28 +176,22 @@ my $tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('/foo');
$app->handler($tx);
-is($tx->res->code, 200, 'right status');
-like(
- $tx->res->body,
- qr/Hello Mojo from the template \/foo! Hello World!/,
- 'right content'
-);
+is $tx->res->code, 200, 'right status';
+like $tx->res->body, qr/Hello Mojo from the template \/foo! Hello World!/,
+ 'right content';
$tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('/foo/willdie');
$app->handler($tx);
-is($tx->res->code, 500, 'right status');
-like($tx->res->body, qr/Foo\.pm/, 'right content');
+is $tx->res->code, 500, 'right status';
+like $tx->res->body, qr/Foo\.pm/, 'right content';
$tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('/foo');
$app->handler($tx);
-is($tx->res->code, 200, 'right status');
-like(
- $tx->res->body,
- qr/Hello Mojo from the template \/foo! Hello World!/,
- 'right content'
-);
+is $tx->res->code, 200, 'right status';
+like $tx->res->body, qr/Hello Mojo from the template \/foo! Hello World!/,
+ 'right content';
$t = Test::Mojo->new(app => 'SingleFileTestApp');
@@ -219,6 +200,12 @@ $t->get_ok('/foo')->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_like(qr/Same old in green Seems to work!/);
+# SingleFileTestApp (helper)
+$t->get_ok('/helper')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('Welcome aboard!');
+
# SingleFileTestApp::Foo::data_template
$t->get_ok('/foo/data_template')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
@@ -8,13 +8,7 @@ use utf8;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 38;
+use Test::More tests => 38;
# In the game of chess you can never let your adversary see your pieces.
use Mojo::ByteStream 'b';
@@ -36,9 +30,6 @@ app->renderer->add_handler(
}
);
-# Silence
-app->log->level('error');
-
# GET /
get '/' => 'index';
@@ -6,37 +6,28 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 9;
+use Test::More tests => 9;
# Just once I'd like to eat dinner with a celebrity who isn't bound and
# gagged.
use Mojolicious::Lite;
use Test::Mojo;
-# Silence
-app->log->level('error');
-
# Custom dispatchers /custom
-app->plugins->add_hook(
+app->hook(
before_dispatch => sub {
- my ($self, $c) = @_;
- $c->render_text($c->param('a'), status => 205)
- if $c->req->url->path eq '/custom';
+ my $self = shift;
+ $self->render_text($self->param('a'), status => 205)
+ if $self->req->url->path eq '/custom';
}
);
# Custom dispatcher /custom_too
-app->plugins->add_hook(
+app->hook(
after_static_dispatch => sub {
- my ($self, $c) = @_;
- $c->render_text('this works too')
- if $c->req->url->path eq '/custom_too';
+ my $self = shift;
+ $self->render_text('this works too')
+ if $self->req->url->path eq '/custom_too';
}
);
@@ -6,13 +6,7 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 35;
+use Test::More tests => 35;
use FindBin;
use lib "$FindBin::Bin/lib";
@@ -23,9 +17,6 @@ package TestApp;
use Mojolicious::Lite;
-# Silence
-app->log->level('error');
-
# GET /hello (embedded)
get '/hello' => sub {
my $self = shift;
@@ -41,9 +32,6 @@ package MyTestApp::Test1;
use Mojolicious::Lite;
-# Silence
-app->log->level('error');
-
get '/yada' => sub {
my $self = shift;
my $name = $self->stash('name');
@@ -52,17 +40,15 @@ get '/yada' => sub {
# GET /bye (embedded)
get '/bye' => sub {
- my $self = shift;
- my $name = $self->stash('name');
- $self->pause;
+ my $self = shift;
+ my $name = $self->stash('name');
my $async = '';
$self->client->async->get(
'/hello/hello' => sub {
my $client = shift;
$self->render_text($client->res->body . "$name! $async");
- $self->finish;
}
- )->process;
+ )->start;
$async .= 'success!';
};
@@ -78,9 +64,6 @@ sub register {
package Mojolicious::Plugin::MyEmbeddedApp::App;
use Mojolicious::Lite;
-# Silence
-app->log->level('error');
-
# GET /bar
get '/bar' => {text => 'plugin works!'};
@@ -88,9 +71,6 @@ package MyTestApp::Test2;
use Mojolicious::Lite;
-# Silence
-app->log->level('error');
-
# GET / (embedded)
get '/' => sub {
my $self = shift;
@@ -108,6 +88,7 @@ sub handler {
$c->res->code(200);
my $test = $c->param('test');
$c->res->body("Hello $test!");
+ $c->rendered;
}
package main;
@@ -115,9 +96,6 @@ package main;
use Mojolicious::Lite;
use Test::Mojo;
-# Silence
-app->log->level('error');
-
# /foo/* (plugin app)
plugin 'my_embedded_app';
@@ -0,0 +1,3 @@
+{
+ "just": "works!"
+}
\ No newline at end of file
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Boy, who knew a cooler could also make a handy wang coffin?
+use Mojolicious::Lite;
+
+# Load plugin
+plugin 'json_config';
+
+# GET /
+get '/' => 'index';
+
+app->start;
+__DATA__
+@@ index.html.ep
+<%= $config->{just} %>
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use utf8;
+
+# Disable epoll, kqueue and IPv6
+BEGIN {
+ $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_MODE} = 'testing';
+}
+
+# Who are you, and why should I care?
+use Test::More tests => 3;
+
+# Of all the parasites I've had over the years,
+# these worms are among the best.
+use FindBin;
+$ENV{MOJO_HOME} = $FindBin::Bin;
+require "$ENV{MOJO_HOME}/external_lite_app.pl";
+use Test::Mojo;
+
+my $t = Test::Mojo->new;
+
+# GET /
+$t->get_ok('/')->status_is(200)->content_is("works!\n");
@@ -6,13 +6,7 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 24;
+use Test::More tests => 24;
# Aw, he looks like a little insane drunken angel.
package MyTestApp::I18N::de;
@@ -29,9 +23,6 @@ use Test::Mojo;
# I18N plugin
plugin i18n => {namespace => 'MyTestApp::I18N'};
-# Silence
-app->log->level('error');
-
# GET /
get '/' => 'index';
@@ -1,4 +1,4 @@
{
- "foo" : "bar",
- "utf" : "утф"
+ "foo": "bar",
+ "utf": "утф"
}
@@ -8,28 +8,19 @@ use utf8;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 8;
+use Test::More tests => 8;
# Oh, I always feared he might run off like this.
# Why, why, why didn't I break his legs?
use Mojolicious::Lite;
use Test::Mojo;
-# Silence
-app->log->level('error');
-
# Load plugin
my $config =
plugin json_config => {default => {foo => 'baz', hello => 'there'}};
-is($config->{foo}, 'bar', 'right value');
-is($config->{hello}, 'there', 'right value');
-is($config->{utf}, 'утф', 'right value');
+is $config->{foo}, 'bar', 'right value';
+is $config->{hello}, 'there', 'right value';
+is $config->{utf}, 'утф', 'right value';
# GET /
get '/' => 'index';
@@ -42,11 +33,10 @@ $t->get_ok('/')->status_is(200)->content_like(qr/bar/);
# No config file, default only
$config =
plugin json_config => {file => 'nonexisted', default => {foo => 'qux'}};
-is($config->{foo}, 'qux', 'right value');
+is $config->{foo}, 'qux', 'right value';
# No config file, no default
-ok(not(eval { plugin json_config => {file => 'nonexisted'} }),
- 'no config file');
+ok !(eval { plugin json_config => {file => 'nonexisted'} }), 'no config file';
__DATA__
@@ index.html.ep
@@ -0,0 +1,4 @@
+{
+ "foo": "bar",
+ "bar": "foo"
+}
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use utf8;
+
+# Disable epoll, kqueue and IPv6
+BEGIN {
+ $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_MODE} = 'testing';
+}
+
+# Who are you, and why should I care?
+use Test::More tests => 3;
+
+# Ahhh, what an awful dream.
+# Ones and zeroes everywhere... and I thought I saw a two.
+use Mojolicious::Lite;
+use Test::Mojo;
+
+# Load plugin
+plugin 'json_config';
+
+# GET /
+get '/' => 'index';
+
+my $t = Test::Mojo->new;
+
+# GET /
+$t->get_ok('/')->status_is(200)->content_like(qr/bazfoo/);
+
+__DATA__
+@@ index.html.ep
+<%= $config->{foo} %><%= $config->{bar} %>
@@ -0,0 +1,3 @@
+{
+ "foo": "baz"
+}
@@ -2,9 +2,6 @@ package EmbeddedTestApp;
use Mojolicious::Lite;
-# Silence
-app->log->level('error');
-
# But you're better than normal, you're abnormal.
get '/works' => 'works';
@@ -19,14 +19,10 @@ sub config {
$self->render_text($self->stash('config')->{test});
}
-sub exceptionduringpausedtransaction { shift->pause and die 'Exception' }
-
sub index {
- shift->stash(
- layout => 'default',
- handler => 'xpl',
- msg => 'Hello World!'
- );
+ my $self = shift;
+ $self->layout('default');
+ $self->stash(handler => 'xpl', msg => 'Hello World!');
}
sub session_domain {
@@ -52,7 +48,10 @@ sub stage1 {
return;
}
-sub stage2 { shift->render_text('Welcome aboard!') }
+sub stage2 {
+ my $self = shift;
+ $self->render_text($self->test_plugin);
+}
sub syntaxerror { shift->render('syntaxerror', format => 'html') }
@@ -0,0 +1,17 @@
+package MojoliciousTest::Plugin::TestPlugin;
+
+use strict;
+use warnings;
+
+use base 'Mojolicious::Plugin';
+
+# Space: It seems to go on and on forever...
+# but then you get to the end and a gorilla starts throwing barrels at you.
+sub register {
+ my ($self, $app) = @_;
+
+ # Add "test_plugin" helper
+ $app->helper(test_plugin => sub {'Welcome aboard!'});
+}
+
+1;
@@ -16,8 +16,10 @@ sub development_mode {
sub startup {
my $self = shift;
- # Only log errors to STDERR
- $self->log->level('fatal');
+ # Plugin
+ unshift @{$self->plugins->namespaces},
+ $self->routes->namespace . '::Plugin';
+ $self->plugin('test_plugin');
# Templateless renderer
$self->renderer->add_handler(
@@ -30,9 +32,6 @@ sub startup {
# Renderer for a different file extension
$self->renderer->add_handler(xpl => $self->renderer->handler->{epl});
- # Default handler
- $self->renderer->default_handler('epl');
-
# Session domain
$self->session->cookie_domain('.example.com');
@@ -0,0 +1,23 @@
+package PluginWithTemplate;
+
+use strict;
+use warnings;
+
+use base 'Mojolicious::Plugin';
+
+# Good news, everyone! I've taught the toaster to feel love!
+sub register {
+ my ($self, $app) = @_;
+ $app->routes->route('/plugin_with_template')->to(
+ cb => sub {
+ shift->render('template', template_class => __PACKAGE__);
+ }
+ );
+}
+
+1;
+__DATA__
+
+@@ template.html.ep
+% layout plugin_with_template => (template_class => 'main');
+with template
@@ -13,8 +13,16 @@ sub startup {
$self->log->path(undef);
$self->log->level('fatal');
- # Default handler
- $self->renderer->default_handler('epl');
+ # Plugin
+ $self->plugin('MojoliciousTest::Plugin::TestPlugin');
+
+ # Helper route
+ $self->routes->route('/helper')->to(
+ cb => sub {
+ my $self = shift;
+ $self->render(text => $self->test_plugin);
+ }
+ );
# /*/* - the default route
$self->routes->route('/:controller/:action')->to(action => 'index');
@@ -8,13 +8,7 @@ use utf8;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 516;
+use Test::More tests => 664;
# Pollution
123 =~ m/(\d+)/;
@@ -29,7 +23,6 @@ use Mojo::Content::MultiPart;
use Mojo::Content::Single;
use Mojo::Cookie::Response;
use Mojo::Date;
-use Mojo::Filter::Chunked;
use Mojo::JSON;
use Mojo::Transaction::HTTP;
use Mojolicious::Lite;
@@ -38,21 +31,36 @@ use Test::Mojo;
# Mojolicious::Lite and ojo
use ojo;
-# Silence
-app->log->level('error');
-
-# Test with lite templates
-app->renderer->default_handler('epl');
-
# Header condition plugin
plugin 'header_condition';
+# Plugin with a template
+use FindBin;
+use lib "$FindBin::Bin/lib";
+plugin 'PluginWithTemplate';
+
# Default
app->defaults(default => 23);
+# Test helpers
+app->helper(test_helper => sub { shift->param(@_) });
+app->helper(test_helper2 => sub { shift->app->controller_class });
+app->helper(dead => sub { die $_[1] || 'works!' });
+is app->test_helper('foo'), undef, 'no value yet';
+is app->test_helper2, 'Mojolicious::Controller', 'right value';
+
+# Test renderer
+app->renderer->add_handler(dead => sub { die 'renderer works!' });
+
# GET /
get '/' => 'root';
+# GET /with-format
+get '/with-format' => {format => 'html'} => 'with-format';
+
+# GET /without-format
+get '/without-format' => 'without-format';
+
# /ojo
a '/ojo' => {json => {hello => 'world'}};
@@ -62,6 +70,32 @@ get '/null/:null' => sub {
$self->render(text => $self->param('null'), layout => 'layout');
};
+# GET /action_template
+get '/action_template' => {controller => 'foo'} => sub {
+ my $self = shift;
+ $self->render(action => 'bar');
+ $self->rendered;
+};
+
+# GET /dead
+get '/dead' => sub {
+ my $self = shift;
+ $self->dead;
+ $self->render(text => 'failed!');
+};
+
+# GET /dead_template
+get '/dead_template' => 'dead_template';
+
+# GET /dead_renderer
+get '/dead_renderer' => sub { shift->render(handler => 'dead') };
+
+# GET /dead_auto_renderer
+get '/dead_auto_renderer' => {handler => 'dead'};
+
+# GET /regex/in/template
+get '/regex/in/template' => 'test(test)(\Qtest\E)(';
+
# GET /maybe/ajax
get '/maybe/ajax' => sub {
my $self = shift;
@@ -71,29 +105,26 @@ get '/maybe/ajax' => sub {
# GET /stream
get '/stream' => sub {
- my $self = shift;
- my $counter = 0;
- my $chunks = [qw/foo bar/, $self->req->url->to_abs->userinfo,
+ my $self = shift;
+ my $chunks = [qw/foo bar/, $self->req->url->to_abs->userinfo,
$self->url_for->to_abs];
- my $chunked = Mojo::Filter::Chunked->new;
$self->res->code(200);
$self->res->headers->content_type('text/plain');
- $self->res->headers->transfer_encoding('chunked');
- $self->res->body(
- sub {
- my $self = shift;
- my $chunk = $chunks->[$counter] || '';
- $counter++;
- return $chunked->build($chunk);
- }
- );
+ my $cb;
+ $cb = sub {
+ my $self = shift;
+ my $chunk = shift @$chunks || '';
+ $self->write_chunk($chunk, $chunk ? $cb : undef);
+ };
+ $cb->($self->res);
+ $self->rendered;
};
# GET /finished
my $finished;
get '/finished' => sub {
my $self = shift;
- $self->finished(sub { $finished += 3 });
+ $self->on_finish(sub { $finished += 3 });
$finished = 20;
$self->render(text => 'so far so good!');
};
@@ -117,18 +148,32 @@ get ':number' => [number => qr/0/] => sub {
# GET /tags
get 'tags/:test' => 'tags';
-# POST /upload
-post '/upload' => sub {
+# GET /selection
+get 'selection' => '*';
+
+# GET /inline/epl
+get '/inline/epl' => sub { shift->render(inline => '<%= 1 + 1%>') };
+
+# GET /inline/ep
+get '/inline/ep' =>
+ sub { shift->render(inline => "<%= param 'foo' %>works!", handler => 'ep') };
+
+# GET /inline/ep/too
+get '/inline/ep/too' => sub { shift->render(inline => '0', handler => 'ep') };
+
+# GET /inline/ep/partial
+get '/inline/ep/partial' => sub {
my $self = shift;
- $self->stash('mojo.rendered' => 1);
- my $body = $self->res->body || '';
- $self->res->body("called, $body");
- return if $self->req->error;
- if (my $u = $self->req->upload('Вячеслав')) {
- $self->res->body($self->res->body . $u->filename . $u->size);
- }
+ $self->stash(inline_template => "<%= 'just' %>");
+ $self->render(
+ inline => '<%= include inline => $inline_template %>works!',
+ handler => 'ep'
+ );
};
+# GET /source
+get '/source' => sub { shift->render_static('../lite_app.t') };
+
# GET /foo_relaxed/*
get '/foo_relaxed/(.test)' => sub {
my $self = shift;
@@ -170,8 +215,7 @@ post '/with/body/and/headers/desc' => sub {
};
# GET /template_inheritance
-get '/template_inheritance' =>
- sub { shift->render(template => 'template_inheritance') };
+get '/template_inheritance' => sub { shift->render('template_inheritance') };
# GET /layout_without_inheritance
get '/layout_without_inheritance' => sub {
@@ -268,6 +312,9 @@ get '/layout' => sub {
# POST /template
post '/template' => 'index';
+# GET /memorized
+get '/memorized' => 'memorized';
+
# * /something
any '/something' => sub {
my $self = shift;
@@ -320,8 +367,7 @@ get '/app' => {layout => 'app'} => '*';
# GET /helper
get '/helper' => sub { shift->render(handler => 'ep') } => 'helper';
-app->renderer->add_helper(
- agent => sub { scalar shift->req->headers->user_agent });
+app->helper(agent => sub { shift->req->headers->user_agent });
# GET /eperror
get '/eperror' => sub { shift->render(handler => 'ep') } => 'eperror';
@@ -329,14 +375,12 @@ get '/eperror' => sub { shift->render(handler => 'ep') } => 'eperror';
# GET /subrequest
get '/subrequest' => sub {
my $self = shift;
- $self->pause;
$self->client->post(
'/template' => sub {
my $client = shift;
$self->render_text($client->tx->success->body);
- $self->finish;
}
- )->process;
+ )->start;
};
# GET /subrequest_simple
@@ -355,24 +399,26 @@ get '/subrequest_sync' => sub {
my $client = shift;
$self->render_text($client->res->body);
}
- )->process;
+ )->start;
}
- )->process;
+ )->start;
};
+# Make sure hook runs async
+app->hook(after_dispatch => sub { shift->stash->{async} = 'broken!' });
+
# GET /subrequest_async
+my $async;
get '/subrequest_async' => sub {
my $self = shift;
- $self->pause;
- my $async = '';
$self->client->async->post(
'/template' => sub {
my $client = shift;
- $self->render_text($client->res->body . $async);
- $self->finish;
+ $self->render_text($client->res->body . $self->stash->{'async'});
+ $async = $self->stash->{async};
}
- )->process;
- $async .= 'success!';
+ )->start;
+ $self->stash->{'async'} = 'success!';
};
# GET /redirect_url
@@ -411,11 +457,18 @@ get '/koi8-r' => sub {
# GET /hello3.txt
get '/hello3.txt' => sub { shift->render_static('hello2.txt') };
-# Condition
+# GET /captures/*/*
+get '/captures/:foo/:bar' => sub {
+ my $self = shift;
+ $self->render(text => $self->url_for);
+};
+
+# Default condition
app->routes->add_condition(
default => sub {
my ($r, $c, $captures, $num) = @_;
- return $captures if $c->stash->{default} == $num;
+ $captures->{test} = "$num works!";
+ return 1 if $c->stash->{default} == $num;
return;
}
);
@@ -424,13 +477,35 @@ app->routes->add_condition(
get '/default/condition' => (default => 23) => sub {
my $self = shift;
my $default = $self->stash('default');
- $self->render(text => "works $default");
+ my $test = $self->stash('test');
+ $self->render(text => "works $default $test");
+};
+
+# Redirect condition
+app->routes->add_condition(
+ redirect => sub {
+ my ($r, $c, $captures, $active) = @_;
+ return 1 unless $active;
+ $c->redirect_to('index') and return
+ unless $c->req->headers->header('X-Condition-Test');
+ return 1;
+ }
+);
+
+# GET /redirect/condition/0
+get '/redirect/condition/0' => (redirect => 0) => sub {
+ shift->render(text => 'condition works!');
};
+# GET /redirect/condition/1
+get '/redirect/condition/1' => (redirect => 1) =>
+ {text => 'condition works too!'};
+
under sub {
my $self = shift;
return unless $self->req->headers->header('X-Bender');
- $self->res->headers->header('X-Under' => 23);
+ $self->res->headers->add('X-Under' => 23);
+ $self->res->headers->add('X-Under' => 24);
return 1;
};
@@ -488,6 +563,36 @@ under sub {
# GET /with_under_count
get '/with/under/count' => '*';
+# Everything gets past this
+under sub {
+ shift->res->headers->header('X-Possible' => 1);
+ return 1;
+};
+
+# GET /possible
+get '/possible' => 'possible';
+
+# Nothing gets past this
+under sub {
+ shift->res->headers->header('X-Impossible' => 1);
+ return 0;
+};
+
+# GET /impossible
+get '/impossible' => 'impossible';
+
+# Prefix
+under '/prefix';
+
+# GET
+get sub { shift->render(text => 'prefixed GET works!') };
+
+# POST
+post sub { shift->render(text => 'prefixed POST works!') };
+
+# GET /prefix/works
+get '/works' => sub { shift->render(text => 'prefix works!') };
+
# Oh Fry, I love you more than the moon, and the stars,
# and the POETIC IMAGE NUMBER 137 NOT FOUND
my $client = app->client;
@@ -503,7 +608,7 @@ $client->ioloop->timer(
my $self = shift;
$timer = $self->res->body . $async;
}
- )->process;
+ )->start;
$async = 'works!';
}
);
@@ -511,16 +616,27 @@ $client->ioloop->timer(
# GET /
$t->get_ok('/')->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is('/root.html/root.html/root.html/root.html/root.html');
+ ->content_is(
+ "/root.html\n/root.html\n/root.html\n/root.html\n/root.html\n");
# HEAD /
$t->head_ok('/')->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->header_is('Content-Length' => 50)->content_is('');
+ ->header_is('Content-Length' => 55)->content_is('');
# GET / (with body)
$t->get_ok('/', '1234' x 1024)->status_is(200)
- ->content_is('/root.html/root.html/root.html/root.html/root.html');
+ ->content_is(
+ "/root.html\n/root.html\n/root.html\n/root.html\n/root.html\n");
+
+# GET /with-format
+$t->get_ok('/with-format')->content_is("/without-format\n");
+
+# GET /without-format
+$t->get_ok('/without-format')->content_is("/without-format\n");
+
+# GET /without-format.html
+$t->get_ok('/without-format.html')->content_is("/without-format\n");
# GET /ojo (ojo)
$t->get_ok('/ojo')->status_is(200)->json_content_is({hello => 'world'});
@@ -585,6 +701,41 @@ $t->get_ok('/null/0')->status_is(200)
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_like(qr/layouted 0/);
+# GET /action_template
+$t->get_ok('/action_template')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is("controller and action!\n");
+
+# GET /dead
+$t->get_ok('/dead')->status_is(500)->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_like(qr/works!/);
+
+# GET /dead_renderer
+$t->get_ok('/dead_renderer')->status_is(500)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_like(qr/renderer works!/);
+
+# GET /dead_auto_renderer
+$t->get_ok('/dead_auto_renderer')->status_is(500)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_like(qr/renderer works!/);
+
+# GET /dead_template
+$t->get_ok('/dead_template')->status_is(500)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_like(qr/works too!/);
+
+# GET /regex/in/template
+$t->get_ok('/regex/in/template')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is("test(test)(\\Qtest\\E)(\n");
+
# GET /stream (with basic auth)
my $port = $t->client->test_server;
$t->get_ok("sri:foo\@localhost:$port/stream?foo=bar")->status_is(200)
@@ -594,8 +745,7 @@ $t->get_ok("sri:foo\@localhost:$port/stream?foo=bar")->status_is(200)
# GET /stream (with basic auth and ojo)
my $b = g("http://sri:foo\@localhost:$port/stream?foo=bar")->body;
-like($b, qr/^foobarsri\:foohttp:\/\/localhost\:\d+\/stream$/,
- 'right content');
+like $b, qr/^foobarsri\:foohttp:\/\/localhost\:\d+\/stream$/, 'right content';
# GET /maybe/ajax (not ajax)
$t->get_ok('/maybe/ajax')->status_is(200)
@@ -607,31 +757,30 @@ $t->get_ok('/maybe/ajax', {'X-Requested-With' => 'XMLHttpRequest'})
->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')->content_is('is ajax');
-# GET /finished (with finished callback)
+# GET /finished (with on_finish callback)
$t->get_ok('/finished')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_is('so far so good!');
-is($finished, 23, 'finished');
+is $finished, 23, 'finished';
# GET / (IRI)
$t->get_ok('/привет/мир')->status_is(200)
->content_type_is('text/html');
-is( b($t->tx->res->body)->decode('UTF-8'),
- 'привет мир',
- 'right content'
-);
+is b($t->tx->res->body)->decode('UTF-8'), 'привет мир',
+ 'right content';
# GET /root
$t->get_ok('/root.html')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
- ->header_is('X-Powered-By' => 'Mojolicious (Perl)')->content_is('/.html');
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')->content_is("/\n");
# GET /.html
$t->get_ok('/.html')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is('/root.html/root.html/root.html/root.html/root.html');
+ ->content_is(
+ "/root.html\n/root.html\n/root.html\n/root.html\n/root.html\n");
# GET /0 (reverse proxy)
my $backup = $ENV{MOJO_REVERSE_PROXY};
@@ -641,97 +790,196 @@ $t->get_ok('/0', {'X-Forwarded-For' => '192.168.2.2, 192.168.2.1'})
$ENV{MOJO_REVERSE_PROXY} = $backup;
# GET /tags
-$t->get_ok('/tags/lala?a=b')->status_is(200)->content_is(<<EOF);
+$t->get_ok('/tags/lala?a=b&b=0&c=2&d=3&escaped=1%22+%222')->status_is(200)
+ ->content_is(<<EOF);
<foo />
<foo bar="baz" />
<foo one="two" three="four">Hello</foo>
-<a href="/path">/path</a>
+<a href="/path">Path</a>
<a href="http://example.com/" title="Foo">Foo</a>
<a href="http://example.com/">Example</a>
-<a href="/template">Index</a>
-<a href="/tags/23" title="Foo">Tags</a>
-<form action="/template" method="post"><input name="foo" /></form>
+<a href="/template">Home</a>
+<a href="/tags/23" title="Foo">Foo</a>
+<form action="/template" method="post">
+ <input name="foo" />
+</form>
<form action="/tags/24" method="post">
<input name="foo" />
- <input name="foo" type="checkbox" />
- <input checked="checked" name="a" type="checkbox" />
+ <input name="foo" type="checkbox" value="1" />
+ <input checked="checked" name="a" type="checkbox" value="2" />
+ <input name="b" type="radio" value="1" />
+ <input checked="checked" name="b" type="radio" value="0" />
+ <input name="c" type="hidden" value="foo" />
+ <input name="d" type="file" />
+ <textarea cols="40" name="e" rows="50">
+ default!
+ </textarea>
+ <textarea name="f"></textarea>
+ <input name="g" type="password" />
+ <input id="foo" name="h" type="password" />
+ <input type="submit" value="Ok!" />
+ <input id="bar" type="submit" value="Ok too!" />
</form>
<form action="/">
- <label for="foo">Name</label>
<input name="foo" />
</form>
+<input name="escaped" value="1" "2" />
<input name="a" value="b" />
<input name="a" value="b" />
-<script src="/script.js" type="text/javascript" />
-<script type="text/javascript">
+<script src="script.js" type="text/javascript" />
+<script type="text/javascript"><![CDATA[
var a = 'b';
-</script>
-<script type="foo">
+]]></script>
+<script type="foo"><![CDATA[
var a = 'b';
-</script>
-<img src="/foo.jpg" />
-<img alt="image" src="/foo.jpg" />
+]]></script>
+<link href="foo.css" media="screen" rel="stylesheet" type="text/css" />
+<style type="text/css"><![CDATA[
+ body {color: #000}
+]]></style>
+<style type="foo"><![CDATA[
+ body {color: #000}
+]]></style>
EOF
-# POST /upload (huge upload without appropriate max message size)
-$backup = $ENV{MOJO_MAX_MESSAGE_SIZE} || '';
-$ENV{MOJO_MAX_MESSAGE_SIZE} = 2048;
-my $backup2 = app->log->level;
-app->log->level('fatal');
-my $tx = Mojo::Transaction::HTTP->new;
-my $part = Mojo::Content::Single->new;
-my $name = b('Вячеслав')->url_escape;
-$part->headers->content_disposition(
- qq/form-data; name="$name"; filename="$name.jpg"/);
-$part->headers->content_type('image/jpeg');
-$part->asset->add_chunk('1234' x 1024);
-my $content = Mojo::Content::MultiPart->new;
-$content->headers($tx->req->headers);
-$content->headers->content_type('multipart/form-data');
-$content->parts([$part]);
-$tx->req->method('POST');
-$tx->req->url->parse('/upload');
-$tx->req->content($content);
-$client->process($tx);
-is($tx->res->code, 413, 'right status');
-is($tx->res->body, 'called, ', 'right content');
-app->log->level($backup2);
-$ENV{MOJO_MAX_MESSAGE_SIZE} = $backup;
+# GET /tags (alternative)
+$t->get_ok('/tags/lala?c=b&d=3&e=4&f=5')->status_is(200)->content_is(<<EOF);
+<foo />
+<foo bar="baz" />
+<foo one="two" three="four">Hello</foo>
+<a href="/path">Path</a>
+<a href="http://example.com/" title="Foo">Foo</a>
+<a href="http://example.com/">Example</a>
+<a href="/template">Home</a>
+<a href="/tags/23" title="Foo">Foo</a>
+<form action="/template" method="post">
+ <input name="foo" />
+</form>
+<form action="/tags/24" method="post">
+ <input name="foo" />
+ <input name="foo" type="checkbox" value="1" />
+ <input name="a" type="checkbox" value="2" />
+ <input name="b" type="radio" value="1" />
+ <input name="b" type="radio" value="0" />
+ <input name="c" type="hidden" value="foo" />
+ <input name="d" type="file" />
+ <textarea cols="40" name="e" rows="50">4</textarea>
+ <textarea name="f">5</textarea>
+ <input name="g" type="password" />
+ <input id="foo" name="h" type="password" />
+ <input type="submit" value="Ok!" />
+ <input id="bar" type="submit" value="Ok too!" />
+</form>
+<form action="/">
+ <input name="foo" />
+</form>
+<input name="escaped" />
+<input name="a" />
+<input name="a" value="c" />
+<script src="script.js" type="text/javascript" />
+<script type="text/javascript"><![CDATA[
+ var a = 'b';
+]]></script>
+<script type="foo"><![CDATA[
+ var a = 'b';
+]]></script>
+<link href="foo.css" media="screen" rel="stylesheet" type="text/css" />
+<style type="text/css"><![CDATA[
+ body {color: #000}
+]]></style>
+<style type="foo"><![CDATA[
+ body {color: #000}
+]]></style>
+EOF
-# POST /upload (huge upload with appropriate max message size)
-$backup = $ENV{MOJO_MAX_MESSAGE_SIZE} || '';
-$ENV{MOJO_MAX_MESSAGE_SIZE} = 1073741824;
-$tx = Mojo::Transaction::HTTP->new;
-$part = Mojo::Content::Single->new;
-$name = b('Вячеслав')->url_escape;
-$part->headers->content_disposition(
- qq/form-data; name="$name"; filename="$name.jpg"/);
-$part->headers->content_type('image/jpeg');
-$part->asset->add_chunk('1234' x 1024);
-$content = Mojo::Content::MultiPart->new;
-$content->headers($tx->req->headers);
-$content->headers->content_type('multipart/form-data');
-$content->parts([$part]);
-$tx->req->method('POST');
-$tx->req->url->parse('/upload');
-$tx->req->content($content);
-$client->process($tx);
-ok($tx->is_done, 'transaction is done');
-is($tx->res->code, 200, 'right status');
-is( b($tx->res->body)->decode('UTF-8')->to_string,
- 'called, Вячеслав.jpg4096',
- 'right content'
-);
-$ENV{MOJO_MAX_MESSAGE_SIZE} = $backup;
+# GET /selection (empty)
+$t->get_ok('/selection')->status_is(200)
+ ->content_is("<form action=\"/selection\">\n "
+ . '<select name="a">'
+ . '<option value="b">b</option>'
+ . '<optgroup label="c">'
+ . '<option value="d">d</option>'
+ . '<option value="e">E</option>'
+ . '<option value="f">f</option>'
+ . '</optgroup>'
+ . '<option value="g">g</option>'
+ . '</select>'
+ . "\n "
+ . '<select multiple="multiple" name="foo">'
+ . '<option value="bar">bar</option>'
+ . '<option value="baz">baz</option>'
+ . '</select>'
+ . "\n "
+ . '<input type="submit" value="Ok" />' . "\n"
+ . '</form>'
+ . "\n");
+
+# GET /selection (values)
+$t->get_ok('/selection?a=e&foo=bar')->status_is(200)
+ ->content_is("<form action=\"/selection\">\n "
+ . '<select name="a">'
+ . '<option value="b">b</option>'
+ . '<optgroup label="c">'
+ . '<option value="d">d</option>'
+ . '<option selected="selected" value="e">E</option>'
+ . '<option value="f">f</option>'
+ . '</optgroup>'
+ . '<option value="g">g</option>'
+ . '</select>'
+ . "\n "
+ . '<select multiple="multiple" name="foo">'
+ . '<option selected="selected" value="bar">bar</option>'
+ . '<option value="baz">baz</option>'
+ . '</select>'
+ . "\n "
+ . '<input type="submit" value="Ok" />' . "\n"
+ . '</form>'
+ . "\n");
+
+# GET /selection (multiple values)
+$t->get_ok('/selection?foo=bar&a=e&foo=baz')->status_is(200)
+ ->content_is("<form action=\"/selection\">\n "
+ . '<select name="a">'
+ . '<option value="b">b</option>'
+ . '<optgroup label="c">'
+ . '<option value="d">d</option>'
+ . '<option selected="selected" value="e">E</option>'
+ . '<option value="f">f</option>'
+ . '</optgroup>'
+ . '<option value="g">g</option>'
+ . '</select>'
+ . "\n "
+ . '<select multiple="multiple" name="foo">'
+ . '<option selected="selected" value="bar">bar</option>'
+ . '<option selected="selected" value="baz">baz</option>'
+ . '</select>'
+ . "\n "
+ . '<input type="submit" value="Ok" />' . "\n"
+ . '</form>'
+ . "\n");
+
+# GET /inline/epl
+$t->get_ok('/inline/epl')->status_is(200)->content_is("2\n");
+
+# GET /inline/ep
+$t->get_ok('/inline/ep?foo=bar')->status_is(200)->content_is("barworks!\n");
+
+# GET /inline/ep/too
+$t->get_ok('/inline/ep/too')->status_is(200)->content_is("0\n");
+
+# GET /inline/ep/partial
+$t->get_ok('/inline/ep/partial')->status_is(200)
+ ->content_is("just\nworks!\n");
+
+# GET /source
+$t->get_ok('/source')->status_is(200)->content_like(qr/get_ok\('\/source/);
# GET / (with body and max message size)
$backup = $ENV{MOJO_MAX_MESSAGE_SIZE} || '';
$ENV{MOJO_MAX_MESSAGE_SIZE} = 1024;
-$backup2 = app->log->level;
-app->log->level('fatal');
$t->get_ok('/', '1234' x 1024)->status_is(413)
- ->content_is('/root.html/root.html/root.html/root.html/root.html');
-app->log->level($backup2);
+ ->content_is(
+ "/root.html\n/root.html\n/root.html\n/root.html\n/root.html\n");
$ENV{MOJO_MAX_MESSAGE_SIZE} = $backup;
# GET /foo_relaxed/123
@@ -773,20 +1021,23 @@ $t->post_ok('/with/body/and/headers/desc', {with => 'header'}, 'body', 'desc')
$t->get_ok('/template_inheritance')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is(
- "<title>Welcome</title>\nSidebar!\nHello World!\nDefault footer!\n");
+ ->content_is("<title>Welcome</title>Sidebar!Hello World!\nDefault footer!");
# GET /layout_without_inheritance
$t->get_ok('/layout_without_inheritance')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is("Default header!\nDefault sidebar!\nDefault footer!\n");
+ ->content_is('Default header!Default sidebar!Default footer!');
# GET /double_inheritance
$t->get_ok('/double_inheritance')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is("<title>Welcome</title>\nSidebar too!\nDefault footer!\n");
+ ->content_is('<title>Welcome</title>Sidebar too!Default footer!');
+
+# GET /plugin_with_template
+$t->get_ok('/plugin_with_template')->status_is(200)
+ ->content_is("layout_with_template\nwith template\n\n");
# GET /nested-includes
$t->get_ok('/nested-includes')->status_is(200)
@@ -817,7 +1068,7 @@ $t->get_ok('/outerinnerlayout')->status_is(200)
$t->get_ok('/withblocklayout')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is("with_block \nOne: one\nTwo: two\n\n");
+ ->content_is("\nwith_block \n\nOne: one\nTwo: two\n\n");
# GET /session_cookie
$t->get_ok('/session_cookie')->status_is(200)
@@ -839,7 +1090,7 @@ $t->get_ok('/session_cookie/2')->status_is(200)
# GET /session_cookie/2 (session reset)
$t->reset_session;
-ok(!$t->tx, 'session reset');
+ok !$t->tx, 'session reset';
$t->get_ok('/session_cookie/2')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
@@ -856,6 +1107,31 @@ $t->post_ok('/template')->status_is(200)
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_is('Just works!');
+# GET /memorized
+$t->get_ok('/memorized')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_like(qr/\d+a\d+b\d+c\d+d\d+e\d+/);
+my $memorized = $t->tx->res->body;
+
+# GET /memorized
+$t->get_ok('/memorized')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')->content_is($memorized);
+
+# GET /memorized
+$t->get_ok('/memorized')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')->content_is($memorized);
+
+# GET /memorized (expired)
+sleep 2;
+$t->get_ok('/memorized')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_like(qr/\d+a\d+b\d+c\d+d\d+e\d+/);
+isnt($memorized, $t->tx->res->body, 'memorized blocks expired');
+
# GET /something
$t->get_ok('/something')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
@@ -948,9 +1224,7 @@ $t->post_form_ok(
->to_string);
# POST /malformed_utf8
-my $level = app->log->level;
-app->log->level('fatal');
-$tx = Mojo::Transaction::HTTP->new;
+my $tx = Mojo::Transaction::HTTP->new;
$tx->req->method('POST');
$tx->req->url->parse('/malformed_utf8');
$tx->req->headers->content_type('application/x-www-form-urlencoded');
@@ -964,12 +1238,11 @@ $client->queue(
$powered = $tx->res->headers->header('X-Powered-By');
$body = $tx->res->body;
}
-)->process;
-is($code, 200, 'right status');
-is($server, 'Mojolicious (Perl)', 'right "Server" value');
-is($powered, 'Mojolicious (Perl)', 'right "X-Powered-By" value');
-is($body, '%E1', 'right content');
-app->log->level($level);
+)->start;
+is $code, 200, 'right status';
+is $server, 'Mojolicious (Perl)', 'right "Server" value';
+is $powered, 'Mojolicious (Perl)', 'right "X-Powered-By" value';
+is $body, '%E1', 'right content';
# GET /json
$t->get_ok('/json')->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
@@ -981,7 +1254,7 @@ $t->get_ok('/json')->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
$t->get_ok('/autostash?bar=23')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is("layouted bar2342autostash\n");
+ ->content_is("layouted bar\n23\n42\nautostash\n\n");
# GET /app
$t->get_ok('/app')->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
@@ -992,22 +1265,18 @@ $t->get_ok('/app')->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
$t->get_ok('/helper')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is('23<br/><.../template(Mojolicious (Perl))');
+ ->content_is("23\n<br/>\n<...\n/template\n(Mojolicious (Perl))");
# GET /helper
$t->get_ok('/helper', {'User-Agent' => 'Explorer'})->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->content_is('23<br/><.../template(Explorer)');
+ ->content_is("23\n<br/>\n<...\n/template\n(Explorer)");
# GET /eperror
-$level = app->log->level;
-app->log->level('fatal');
$t->get_ok('/eperror')->status_is(500)
->header_is(Server => 'Mojolicious (Perl)')
- ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->text_is('title', 'Internal Server Error');
-app->log->level($level);
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')->content_like(qr/\$c/);
# GET /subrequest
$t->get_ok('/subrequest')->status_is(200)
@@ -1032,6 +1301,7 @@ $t->get_ok('/subrequest_async')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->content_is('Just works!success!');
+is $async, 'broken!', 'right text';
# GET /redirect_url
$t->get_ok('/redirect_url')->status_is(302)
@@ -1097,13 +1367,15 @@ $t->get_ok('/koi8-r')->status_is(200)
$t->get_ok('/with_under', {'X-Bender' => 'Rodriguez'})->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->header_is('X-Under' => 23)->content_is('Unders are cool!');
+ ->header_is('X-Under' => '23, 24')->header_like('X-Under' => qr/23, 24/)
+ ->content_is('Unders are cool!');
# GET /with_under_too
$t->get_ok('/with_under_too', {'X-Bender' => 'Rodriguez'})->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
- ->header_is('X-Under' => 23)->content_is('Unders are cool too!');
+ ->header_is('X-Under' => '23, 24')->header_like('X-Under' => qr/23, 24/)
+ ->content_is('Unders are cool too!');
# GET /with_under_too
$t->get_ok('/with_under_too')->status_is(404)
@@ -1180,7 +1452,26 @@ $t->get_ok('/hello3.txt', {'Range' => 'bytes=0-0'})->status_is(206)
# GET /default/condition
$t->get_ok('/default/condition')->status_is(200)
->header_is(Server => 'Mojolicious (Perl)')
- ->header_is('X-Powered-By' => 'Mojolicious (Perl)')->content_is('works 23');
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('works 23 23 works!');
+
+# GET /redirect/condition/0
+$t->get_ok('/redirect/condition/0')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('condition works!');
+
+# GET /redirect/condition/1
+$t->get_ok('/redirect/condition/1')->status_is(302)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->header_like('Location' => qr/\/template$/)->content_is('');
+
+# GET /redirect/condition/1 (with condition header)
+$t->get_ok('/redirect/condition/1' => {'X-Condition-Test' => 1})
+ ->status_is(200)->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('condition works too!');
# GET /bridge2stash
$t->get_ok('/bridge2stash' => {'X-Flash' => 1})->status_is(200)
@@ -1207,44 +1498,133 @@ $t->get_ok('/with/under/count', {'X-Bender' => 'Rodriguez'})->status_is(200)
->header_is('X-Powered-By' => 'Mojolicious (Perl)')
->header_is('X-Under' => 1)->content_is("counter\n");
+# GET /possible
+$t->get_ok('/possible')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->header_is('X-Possible' => 1)->header_is('X-Impossible' => undef)
+ ->content_is("Possible!\n");
+
+# GET /impossible
+$t->get_ok('/impossible')->status_is(404)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->header_is('X-Possible' => undef)->header_is('X-Impossible' => 1)
+ ->content_is("Oops!\n");
+
+# GET /prefix
+$t->get_ok('/prefix')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('prefixed GET works!');
+
+# POST /prefix
+$t->post_ok('/prefix')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('prefixed POST works!');
+
+# GET /prefix/works
+$t->get_ok('/prefix/works')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('prefix works!');
+
+# GET /captures/foo/bar
+$t->get_ok('/captures/foo/bar')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('/captures/foo/bar');
+
+# GET /captures/bar/baz
+$t->get_ok('/captures/bar/baz')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('/captures/bar/baz');
+
+# GET /captures/♥/☃
+$t->get_ok('/captures/♥/☃')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_is('/captures/%E2%99%A5/%E2%98%83');
+is b($t->tx->res->body)->url_unescape->decode('UTF-8'),
+ '/captures/♥/☃', 'right result';
+
# Client timer
$client->ioloop->one_tick('0.1');
-is( $timer,
- '/root.html/root.html/root.html/root.html/root.htmlworks!',
- 'right content'
-);
+is $timer,
+ "/root.html\n/root.html\n/root.html\n/root.html\n/root.html\nworks!",
+ 'right content';
__DATA__
+@@ with-format.html.ep
+<%= url_for 'without-format' %>
+
+@@ without-format.html.ep
+<%= url_for 'without-format' %>
+
+@@ foo/bar.html.ep
+controller and action!
+
+@@ dead_template.html.ep
+<%= dead 'works too!' %>
+
@@ tags.html.ep
<%= tag 'foo' %>
<%= tag 'foo', bar => 'baz' %>
-<%= tag 'foo', one => 'two', three => 'four' => {%>Hello<%}%>
-<%= link_to '/path' %>
+<%= tag 'foo', one => 'two', three => 'four' => begin %>Hello<% end %>
+<%= link_to Path => '/path' %>
<%= link_to 'http://example.com/', title => 'Foo', sub { 'Foo' } %>
-<%= link_to 'http://example.com/' => {%>Example<%}%>
-<%= link_to 'index' %>
-<%= link_to 'tags', {test => 23}, title => 'Foo' %>
-<%= form_for 'index', method => 'post' => {%><%= input 'foo' %><%}%>
-<%= form_for 'tags', {test => 24}, method => 'post' => {%>
- <%= input 'foo' %>
- <%= input 'foo', type => 'checkbox' %>
- <%= input 'a', type => 'checkbox' %>
-<%}%>
-<%= form_for '/' => {%>
- <%= label 'foo' => {%>Name<%}%>
- <%= input 'foo' %>
-<%}%>
-<%= input 'a' %>
-<%= input 'a', value => 'c' %>
-<%= script '/script.js' %>
-<%= script {%>
+<%= link_to 'http://example.com/' => begin %>Example<% end %>
+<%= link_to Home => 'index' %>
+<%= link_to Foo => 'tags', {test => 23}, title => 'Foo' %>
+<%= form_for 'index', method => 'post' => begin %>
+ <%= input_tag 'foo' %>
+<% end %>
+%= form_for 'tags', {test => 24}, method => 'post' => begin
+ %= text_field 'foo'
+ %= check_box foo => 1
+ %= check_box a => 2
+ %= radio_button b => '1'
+ %= radio_button b => '0'
+ %= hidden_field c => 'foo'
+ %= file_field 'd'
+ %= text_area e => (cols => 40, rows => 50) => begin
+ default!
+ %= end
+ %= text_area 'f'
+ %= password_field 'g'
+ %= password_field 'h', id => 'foo'
+ %= submit_button 'Ok!'
+ %= submit_button 'Ok too!', id => 'bar'
+%= end
+<%= form_for '/' => begin %>
+ <%= input_tag 'foo' %>
+<% end %>
+<%= input_tag 'escaped' %>
+<%= input_tag 'a' %>
+<%= input_tag 'a', value => 'c' %>
+<%= javascript 'script.js' %>
+<%= javascript begin %>
var a = 'b';
-<%}%>
-<%= script type => 'foo' => {%>
+<% end %>
+<%= javascript type => 'foo' => begin %>
var a = 'b';
-<%}%>
-<%= img '/foo.jpg' %>
-<%= img '/foo.jpg', alt => 'image' %>
+<% end %>
+<%= stylesheet 'foo.css' %>
+<%= stylesheet begin %>
+ body {color: #000}
+<% end %>
+<%= stylesheet type => 'foo' => begin %>
+ body {color: #000}
+<% end %>
+
+@@ selection.html.ep
+%= form_for selection => begin
+ %= select_field a => ['b', [c => ['d', [ E => 'e'], 'f']], 'g']
+ %= select_field foo => [qw/bar baz/], multiple => 'multiple'
+ %= submit_button
+%= end
@@ static.txt
Just some
@@ -1253,6 +1633,28 @@ text!
@@ template.txt.epl
<div id="foo">Redirect works!</div>
+@@ memorized.html.ep
+<%= memorize begin =%>
+<%= time =%>
+<% end =%>
+<%= memorize begin =%>
+ <%= 'a' . int(rand(999)) =%>
+<% end =%><%= memorize begin =%>
+<%= 'b' . int(rand(999)) =%>
+<% end =%>
+<%= memorize test => begin =%>
+<%= 'c' . time . int(rand(999)) =%>
+<% end =%>
+<%= memorize expiry => {expires => time + 1} => begin %>
+<%= 'd' . time . int(rand(999)) =%>
+<% end =%>
+<%= memorize {expires => time + 1} => begin %>
+<%= 'e' . time . int(rand(999)) =%>
+<% end =%>
+
+@@ test(test)(\Qtest\E)(.html.ep
+<%= $self->match->endpoint->name %>
+
@@ static2.txt (base64)
dGVzdCAxMjMKbGFsYWxh
@@ -1261,32 +1663,36 @@ Test ok
@@ template_inheritance.html.ep
% layout 'template_inheritance';
-%{ content header =>
-<title>Welcome</title>
-%}
-%{ content sidebar =>
+<% content header => begin =%>
+<%= b('<title>Welcome</title>') %>
+<% end =%>
+<% content sidebar => begin =%>
Sidebar!
-%}
+<% end =%>
Hello World!
@@ layouts/template_inheritance.html.ep
% stash foo => 'Default';
-%{= content header =>
+<%= content header => begin =%>
Default header!
-%}
-%{= content sidebar =>
+<% end =%>
+<%= content sidebar => begin =%>
<%= stash 'foo' %> sidebar!
-%}
+<% end =%>
%= content
-%{= content footer =>
+<%= content footer => begin =%>
Default footer!
-%}
+<% end =%>
@@ double_inheritance.html.ep
% extends 'template_inheritance';
-%{ content sidebar =>
+<% content sidebar => begin =%>
Sidebar too!
-%}
+<% end =%>
+
+@@ layouts/plugin_with_template.html.ep
+layout_with_template
+<%= content %>
@@ nested-includes.html.ep
Nested <%= include 'outerlayout' %>
@@ -1333,9 +1739,9 @@ Just works!\
<%= shift->render_inner %> with layout
@@ autostash.html.ep
-% $self->helper(layout => 'layout');
+% $self->layout('layout');
%= $foo
-%= param 'bar'
+%= $self->test_helper('bar')
% my $foo = 42;
%= $foo
%= $self->match->endpoint->name;
@@ -1344,11 +1750,11 @@ Just works!\
layouted <%== content %>
@@ layouts/with_block.html.epl
-%{ my $block =
+<% my $block = begin %>
<% my ($one, $two) = @_; %>
One: <%= $one %>
Two: <%= $two %>
-%}
+<% end %>
with_block <%= $block->('one', 'two') %>
@@ layouts/app23.html.ep
@@ -1381,6 +1787,12 @@ app layout <%= content %><%= app->mode %>
@@ withundercount.html.ep
counter
+@@ possible.html.ep
+Possible!
+
+@@ impossible.html.ep
+Impossible
+
__END__
This is not a template!
lalala
@@ -0,0 +1,178 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable epoll, kqueue and IPv6
+BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
+
+use Test::More tests => 49;
+
+# I was God once.
+# Yes, I saw. You were doing well until everyone died.
+use Mojolicious::Lite;
+use Test::Mojo;
+
+# GET /shortpoll
+my $shortpoll;
+get '/shortpoll' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $shortpoll = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->write_chunk('this was short.');
+ $self->write_chunk('');
+};
+
+# GET /shortpoll/plain
+my $shortpoll_plain;
+get '/shortpoll/plain' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $shortpoll_plain = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->res->headers->content_length(25);
+ $self->write('this was short and plain.');
+};
+
+# GET /longpoll
+my $longpoll;
+get '/longpoll' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $longpoll = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->write_chunk('hi ');
+ $self->client->ioloop->timer(
+ '0.5' => sub {
+ $self->write_chunk('there,',
+ sub { shift->write_chunk(' whats up?'); });
+ shift->timer('0.5' => sub { $self->write_chunk('') });
+ }
+ );
+};
+
+# GET /longpoll/nested
+my $longpoll_nested;
+get '/longpoll/nested' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $longpoll_nested = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->write_chunk(
+ sub {
+ shift->write_chunk('nested!', sub { shift->write_chunk('') });
+ }
+ );
+};
+
+# GET /longpoll/plain
+my $longpoll_plain;
+get '/longpoll/plain' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $longpoll_plain = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->res->headers->content_length(25);
+ $self->write('hi ');
+ $self->client->ioloop->timer(
+ '0.5' => sub {
+ $self->write('there plain,', sub { shift->write(' whats up?') });
+ }
+ );
+};
+
+# GET /longpoll/delayed
+my $longpoll_delayed;
+get '/longpoll/delayed' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $longpoll_delayed = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->write_chunk;
+ $self->client->ioloop->timer(
+ '0.5' => sub {
+ $self->write_chunk(
+ sub {
+ my $self = shift;
+ $self->write_chunk('how');
+ $self->write_chunk('dy!');
+ $self->write_chunk('');
+ }
+ );
+ }
+ );
+};
+
+# GET /longpoll/plain/delayed
+my $longpoll_plain_delayed;
+get '/longpoll/plain/delayed' => sub {
+ my $self = shift;
+ $self->on_finish(sub { $longpoll_plain_delayed = 'finished!' });
+ $self->res->code(200);
+ $self->res->headers->content_type('text/plain');
+ $self->res->headers->content_length(12);
+ $self->write;
+ $self->client->ioloop->timer(
+ '0.5' => sub {
+ $self->write(
+ sub {
+ my $self = shift;
+ $self->write('how');
+ $self->write('dy plain!');
+ }
+ );
+ }
+ );
+};
+
+my $t = Test::Mojo->new;
+
+# GET /shortpoll
+$t->get_ok('/shortpoll')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')->content_is('this was short.');
+is $shortpoll, 'finished!', 'finished';
+
+# GET /shortpoll/plain
+$t->get_ok('/shortpoll/plain')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')->content_is('this was short and plain.');
+is $shortpoll_plain, 'finished!', 'finished';
+
+# GET /longpoll
+$t->get_ok('/longpoll')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')->content_is('hi there, whats up?');
+is $longpoll, 'finished!', 'finished';
+
+# GET /longpoll/nested
+$t->get_ok('/longpoll/nested')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')->content_is('nested!');
+is $longpoll_nested, 'finished!', 'finished';
+
+# GET /longpoll/plain
+$t->get_ok('/longpoll/plain')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')->content_is('hi there plain, whats up?');
+is $longpoll_plain, 'finished!', 'finished';
+
+# GET /longpoll/delayed
+$t->get_ok('/longpoll/delayed')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')->content_is('howdy!');
+is $longpoll_delayed, 'finished!', 'finished';
+
+# GET /longpoll/plain/delayed
+$t->get_ok('/longpoll/plain/delayed')->status_is(200)
+ ->header_is(Server => 'Mojolicious (Perl)')
+ ->header_is('X-Powered-By' => 'Mojolicious (Perl)')
+ ->content_type_is('text/plain')->content_is('howdy plain!');
+is $longpoll_plain_delayed, 'finished!', 'finished';
@@ -6,15 +6,10 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
plan skip_all => 'Perl 5.10 required for this test!'
unless eval { require Pod::Simple::HTML; 1 };
-plan tests => 9;
+plan tests => 10;
# Amy get your pants back on and get to work.
# They think were making out.
@@ -25,9 +20,6 @@ use Test::Mojo;
# POD renderer plugin
plugin 'pod_renderer';
-# Silence
-app->log->level('error');
-
# GET /
get '/' => sub {
my $self = shift;
@@ -48,7 +40,8 @@ $t->get_ok('/')->status_is(200)
# POD helper
$t->post_ok('/')->status_is(200)
- ->content_like(qr/test123\s+<h1>lalala<\/h1>\s+<p><code>test<\/code><\/p>/);
+ ->content_like(qr/test123\s+<h1>A<\/h1>\s+<h1>B<\/h1>/)
+ ->content_like(qr/\s+<p><code>test<\/code><\/p>/);
# POD filter
$t->post_ok('/block')->status_is(200)
@@ -57,9 +50,9 @@ $t->post_ok('/block')->status_is(200)
__DATA__
@@ index.html.ep
-test123<%= pod_to_html "=head1 lalala\n\nC<test>"%>
+test123<%= pod_to_html "=head1 A\n\n=head1 B\n\nC<test>"%>
@@ block.html.ep
-test321<%= pod_to_html {%>=head2 lalala
+test321<%= pod_to_html begin %>=head2 lalala
-C<test><%}%>
+C<test><% end %>
@@ -6,13 +6,7 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 26;
+use Test::More tests => 26;
use FindBin;
use lib "$FindBin::Bin/lib";
@@ -20,7 +14,7 @@ use lib "$FindBin::Bin/lib";
use Test::Mojo;
# This concludes the part of the tour where you stay alive.
-use_ok('MojoliciousTest');
+use_ok 'MojoliciousTest';
my $t = Test::Mojo->new(app => 'MojoliciousTest');
@@ -5,4 +5,4 @@
% }
% else {
Internal Server Error
-% }
\ No newline at end of file
+% }
@@ -1,6 +1,6 @@
-<% my $block = {%>
+<% my $block = begin %>
<% my $name = shift; =%>
Hello <%= $name %>.
-<%}%>
+<% end %>
%= $block->('Baerbel')
%= $block->('Wolfgang')
@@ -1,4 +1,4 @@
-** my $foo = 23;
+. my $foo = 23;
{
"test": *** $foo **
}
\ No newline at end of file
@@ -6,12 +6,7 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
plan skip_all => 'Perl 5.10 required for this test!'
unless eval { require Pod::Simple::HTML; 1 };
plan tests => 17;
@@ -22,16 +17,13 @@ plan tests => 17;
use Mojolicious::Lite;
use Test::Mojo;
-# Silence
-app->log->level('error');
-
# Twinkle template syntax
my $twinkle = {
- capture_end => '.',
+ capture_end => '-',
capture_start => '+',
escape_mark => '*',
expression_mark => '*',
- line_start => '**',
+ line_start => '.',
tag_end => '**',
tag_start => '**',
trim_mark => '*'
@@ -43,8 +35,8 @@ plugin 'pod_renderer';
plugin pod_renderer => {name => 'teapod', preprocess => 'twinkle'};
my $config = plugin json_config =>
{default => {foo => 'bar'}, ext => 'conf', template => $twinkle};
-is($config->{foo}, 'bar', 'right value');
-is($config->{test}, 23, 'right value');
+is $config->{foo}, 'bar', 'right value';
+is $config->{test}, 23, 'right value';
# GET /
get '/' => {name => '<sebastian>'} => 'index';
@@ -68,7 +60,7 @@ $t->get_ok('/')->status_is(200)->content_like(qr/testHello <sebastian>!123/);
# GET /advanced
$t->get_ok('/advanced')->status_is(200)
- ->content_is('<escape me>123423');
+ ->content_is("<escape me>\n123423");
# GET /docs
$t->get_ok('/docs')->status_is(200)->content_like(qr/<h3>snowman<\/h3>/);
@@ -81,23 +73,23 @@ $t->get_ok('/docs3')->status_is(200)->content_like(qr/<h3><\/h3>/);
__DATA__
@@ index.html.twinkle
-** layout 'twinkle';
+. layout 'twinkle';
Hello **** $name **!\
@@ layouts/twinkle.html.ep
test<%= content %>123\
@@ advanced.html.twinkle
-*** '<escape me>'
-** my $numbers = [1 .. 4];
+.* '<escape me>'
+. my $numbers = [1 .. 4];
** for my $i (@$numbers) { ***
*** $i ***
** } ***
- ** my $foo = block *+** 23 **.*** *** $foo ***
+ ** my $foo = block +*** 23 **-*** *** $foo ***
@@ docs.html.pod
% no warnings;
<%= '=head3 ' . $codename %>
@@ docs2.html.teapod
-*** '=head2 ' . $codename
+.** '=head2 ' . $codename
@@ -3,24 +3,51 @@
use strict;
use warnings;
+use utf8;
+
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 12;
+plan skip_all => 'Windows is too fragile for this test!' if $^O eq 'MSWin32';
+plan tests => 25;
# Um, Leela, Armondo and I are going to the back seat of his car for coffee.
use Mojo::Asset::File;
+use Mojo::ByteStream 'b';
use Mojolicious::Lite;
use Test::Mojo;
-# Silence
-app->log->level('error');
+# Upload progress
+my $cache = {};
+app->hook(
+ after_build_tx => sub {
+ my $tx = shift;
+ $tx->req->on_progress(
+ sub {
+ my $req = shift;
+
+ # Upload id parameter
+ return unless my $id = $req->url->query->param('upload_id');
+
+ # Cache
+ my $c = $cache->{$id} ||= [0];
+
+ # Expected content length
+ return
+ unless my $length = $req->headers->content_length;
+
+ # Current progress
+ my $progress = $req->content->progress;
+
+ # Update cache
+ push @$c, $progress == $length
+ ? 100
+ : int($progress / ($length / 100));
+ }
+ );
+ }
+);
# GET /upload
post '/upload' => sub {
@@ -34,6 +61,25 @@ post '/upload' => sub {
. ($h->header('X-X') || ''));
};
+# GET /progress
+get '/progress/:id' => sub {
+ my $self = shift;
+ my $id = $self->param('id');
+ $self->render_text(($cache->{$id}->[-1] || 0) . '%');
+};
+
+# POST /uploadlimit
+post '/uploadlimit' => sub {
+ my $self = shift;
+ $self->rendered;
+ my $body = $self->res->body || '';
+ $self->res->body("called, $body");
+ return if $self->req->is_limit_exceeded;
+ if (my $u = $self->req->upload('Вячеслав')) {
+ $self->res->body($self->res->body . $u->filename . $u->size);
+ }
+};
+
my $t = Test::Mojo->new;
# POST /upload (asset and filename)
@@ -54,3 +100,61 @@ $t->post_form_ok('/upload', {file => {content => 'alalal'}, test => 'tset'})
my $hash = {content => 'alalal', 'Content-Type' => 'foo/bar', 'X-X' => 'Y'};
$t->post_form_ok('/upload', {file => $hash, test => 'tset'})->status_is(200)
->content_is('filealalaltsetfoo/barY');
+
+# POST /upload (with progress)
+$t->post_form_ok('/upload?upload_id=23',
+ {file => {content => 'alalal'}, test => 'tset'})->status_is(200)
+ ->content_is('filealalaltsetapplication/octet-stream');
+
+# GET/progress/23
+$t->get_ok('/progress/23')->status_is(200)->content_is('100%');
+ok @{$cache->{23}} > 1, 'made progress';
+ok $cache->{23}->[0] < $cache->{23}->[-1], 'progress increased';
+
+my $client = $t->client;
+
+# POST /uploadlimit (huge upload without appropriate max message size)
+my $backup = $ENV{MOJO_MAX_MESSAGE_SIZE} || '';
+$ENV{MOJO_MAX_MESSAGE_SIZE} = 2048;
+my $tx = Mojo::Transaction::HTTP->new;
+my $part = Mojo::Content::Single->new;
+my $name = b('Вячеслав')->url_escape;
+$part->headers->content_disposition(
+ qq/form-data; name="$name"; filename="$name.jpg"/);
+$part->headers->content_type('image/jpeg');
+$part->asset->add_chunk('1234' x 1024);
+my $content = Mojo::Content::MultiPart->new;
+$content->headers($tx->req->headers);
+$content->headers->content_type('multipart/form-data');
+$content->parts([$part]);
+$tx->req->method('POST');
+$tx->req->url->parse('/uploadlimit');
+$tx->req->content($content);
+$client->start($tx);
+is $tx->res->code, 413, 'right status';
+is $tx->res->body, 'called, ', 'right content';
+$ENV{MOJO_MAX_MESSAGE_SIZE} = $backup;
+
+# POST /uploadlimit (huge upload with appropriate max message size)
+$backup = $ENV{MOJO_MAX_MESSAGE_SIZE} || '';
+$ENV{MOJO_MAX_MESSAGE_SIZE} = 1073741824;
+$tx = Mojo::Transaction::HTTP->new;
+$part = Mojo::Content::Single->new;
+$name = b('Вячеслав')->url_escape;
+$part->headers->content_disposition(
+ qq/form-data; name="$name"; filename="$name.jpg"/);
+$part->headers->content_type('image/jpeg');
+$part->asset->add_chunk('1234' x 1024);
+$content = Mojo::Content::MultiPart->new;
+$content->headers($tx->req->headers);
+$content->headers->content_type('multipart/form-data');
+$content->parts([$part]);
+$tx->req->method('POST');
+$tx->req->url->parse('/uploadlimit');
+$tx->req->content($content);
+$client->start($tx);
+ok $tx->is_done, 'transaction is done';
+is $tx->res->code, 200, 'right status';
+is b($tx->res->body)->decode('UTF-8')->to_string,
+ 'called, Вячеслав.jpg4096', 'right content';
+$ENV{MOJO_MAX_MESSAGE_SIZE} = $backup;
@@ -6,13 +6,7 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless Mojo::IOLoop->new->generate_port;
-plan tests => 27;
+use Test::More tests => 29;
# Oh, dear. She’s stuck in an infinite loop and he’s an idiot.
# Well, that’s love for you.
@@ -29,24 +23,31 @@ app->log->level('fatal');
# Avoid exception template
app->renderer->root(app->home->rel_dir('public'));
+# GET /link
+get '/link' => sub {
+ my $self = shift;
+ $self->render(text => $self->url_for('index')->to_abs);
+};
+
# WebSocket /
my $flag;
websocket '/' => sub {
my $self = shift;
- $self->finished(sub { $flag += 4 });
- $self->receive_message(
+ $self->on_finish(sub { $flag += 4 });
+ $self->on_message(
sub {
my ($self, $message) = @_;
- $self->send_message("${message}test2");
+ my $url = $self->url_for->to_abs;
+ $self->send_message("${message}test2$url");
$flag = 20;
}
);
-};
+} => 'index';
# WebSocket /socket
websocket '/socket' => sub {
my $self = shift;
- $self->send_message(scalar $self->req->headers->host);
+ $self->send_message($self->req->headers->host);
$self->finish;
};
@@ -54,7 +55,7 @@ websocket '/socket' => sub {
websocket '/early_start' => sub {
my $self = shift;
$self->send_message('test1');
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$self->send_message("${message}test2");
@@ -67,8 +68,8 @@ websocket '/early_start' => sub {
my ($handshake, $denied) = 0;
websocket '/denied' => sub {
my $self = shift;
- $self->tx->handshake->finished(sub { $handshake += 2 });
- $self->finished(sub { $denied += 1 });
+ $self->tx->handshake->on_finish(sub { $handshake += 2 });
+ $self->on_finish(sub { $denied += 1 });
$self->render(text => 'denied', status => 403);
};
@@ -79,7 +80,7 @@ websocket '/subreq' => sub {
$self->client->async->websocket(
'/echo' => sub {
my $client = shift;
- $client->receive_message(
+ $client->on_message(
sub {
my ($client, $message) = @_;
$self->send_message($message);
@@ -89,14 +90,14 @@ websocket '/subreq' => sub {
);
$client->send_message('test1');
}
- )->process;
+ )->start;
$self->send_message('test0');
- $self->finished(sub { $subreq += 3 });
+ $self->on_finish(sub { $subreq += 3 });
};
# WebSocket /echo
websocket '/echo' => sub {
- shift->receive_message(
+ shift->on_message(
sub {
my ($self, $message) = @_;
$self->send_message($message);
@@ -108,22 +109,28 @@ websocket '/echo' => sub {
websocket '/dead' => sub { die 'i see dead processes' };
# WebSocket /foo
-websocket '/foo' => sub { shift->res->code('403')->message("i'm a teapot") };
+websocket '/foo' =>
+ sub { shift->rendered->res->code('403')->message("i'm a teapot") };
# WebSocket /deadcallback
websocket '/deadcallback' => sub {
my $self = shift;
- $self->receive_message(sub { die 'i see dead callbacks' });
+ $self->on_message(sub { die 'i see dead callbacks' });
};
my $client = Mojo::Client->singleton->app(app);
+# GET /link
+my $res = $client->get('/link')->success;
+is $res->code, 200, 'right status';
+like $res->body, qr/ws\:\/\/localhost\:\d+\//, 'right content';
+
# WebSocket /
my $result;
$client->websocket(
'/' => sub {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -132,20 +139,20 @@ $client->websocket(
);
$self->send_message('test1');
}
-)->process;
-is($result, 'test1test2', 'right result');
+)->start;
+like $result, qr/test1test2ws\:\/\/localhost\:\d+\//, 'right result';
# WebSocket / (ojo)
$result = undef;
w '/' => sub {
- shift->receive_message(
+ shift->on_message(
sub {
shift->finish;
$result = shift;
}
)->send_message('test1');
};
-is($result, 'test1test2', 'right result');
+like $result, qr/test1test2ws\:\/\/localhost\:\d+\//, 'right result';
# WebSocket /socket (using an already prepared socket)
my $peer = $client->test_server;
@@ -159,10 +166,10 @@ my $socket = IO::Socket::INET->new(
);
$tx->connection($socket);
my $port;
-$client->process(
+$client->start(
$tx => sub {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -171,9 +178,9 @@ $client->process(
);
$port = $self->ioloop->local_info($self->tx->connection)->{port};
}
-)->process;
-is($result, 'lalala', 'right result');
-is($port, $local, 'right local port');
+);
+is $result, 'lalala', 'right result';
+is $port, $local, 'right local port';
# WebSocket /early_start (server directly sends a message)
my $flag2;
@@ -181,8 +188,8 @@ $result = undef;
$client->websocket(
'/early_start' => sub {
my $self = shift;
- $self->finished(sub { $flag2 += 5 });
- $self->receive_message(
+ $self->on_finish(sub { $flag2 += 5 });
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -191,16 +198,16 @@ $client->websocket(
}
);
}
-)->process;
-is($result, 'test3test2', 'right result');
-is($flag2, 23, 'finished callback');
+)->start;
+is $result, 'test3test2', 'right result';
+is $flag2, 23, 'finished callback';
# WebSocket /denied (connection denied)
my $code = undef;
-$client->websocket('/denied' => sub { $code = shift->res->code })->process;
-is($code, 403, 'right status');
-is($handshake, 2, 'finished handshake');
-is($denied, 1, 'finished websocket');
+$client->websocket('/denied' => sub { $code = shift->res->code })->start;
+is $code, 403, 'right status';
+is $handshake, 2, 'finished handshake';
+is $denied, 1, 'finished websocket';
# WebSocket /subreq
my $finished = 0;
@@ -210,20 +217,20 @@ $client->websocket(
my $self = shift;
$code = $self->res->code;
$result = '';
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result .= $message;
$self->finish if $message eq 'test1';
}
);
- $self->finished(sub { $finished += 4 });
+ $self->on_finish(sub { $finished += 4 });
}
-)->process;
-is($code, 101, 'right status');
-is($result, 'test0test1', 'right result');
-is($finished, 4, 'finished client websocket');
-is($subreq, 3, 'finished server websocket');
+)->start;
+is $code, 101, 'right status';
+is $result, 'test0test1', 'right result';
+is $finished, 4, 'finished client websocket';
+is $subreq, 3, 'finished server websocket';
# WebSocket /subreq (async)
my $running = 2;
@@ -234,40 +241,40 @@ $client->async->websocket(
my $self = shift;
$code = $self->res->code;
$result = '';
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result .= $message;
$self->finish and $running-- if $message eq 'test1';
- $self->ioloop->idle_cb(sub { shift->stop }) unless $running;
+ $self->ioloop->on_idle(sub { shift->stop }) unless $running;
}
);
- $self->finished(sub { $finished += 1 });
+ $self->on_finish(sub { $finished += 1 });
}
-)->process;
+)->start;
$client->async->websocket(
'/subreq' => sub {
my $self = shift;
$code2 = $self->res->code;
$result2 = '';
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result2 .= $message;
$self->finish and $running-- if $message eq 'test1';
- $self->ioloop->idle_cb(sub { shift->stop }) unless $running;
+ $self->ioloop->on_idle(sub { shift->stop }) unless $running;
}
);
- $self->finished(sub { $finished += 2 });
+ $self->on_finish(sub { $finished += 2 });
}
-)->process;
+)->start;
$client->ioloop->start;
-is($code, 101, 'right status');
-is($result, 'test0test1', 'right result');
-is($code2, 101, 'right status');
-is($result2, 'test0test1', 'right result');
-is($finished, 7, 'finished client websocket');
-is($subreq, 9, 'finished server websocket');
+is $code, 101, 'right status';
+is $result, 'test0test1', 'right result';
+is $code2, 101, 'right status';
+is $result2, 'test0test1', 'right result';
+is $finished, 7, 'finished client websocket';
+is $subreq, 9, 'finished server websocket';
# WebSocket /dead (dies)
$code = undef;
@@ -280,11 +287,11 @@ $client->websocket(
$code = $self->res->code;
$message = $self->res->message;
}
-)->process;
-is($done, 1, 'transaction is done');
-is($websocket, 0, 'no websocket');
-is($code, 500, 'right status');
-is($message, 'Internal Server Error', 'right message');
+)->start;
+is $done, 1, 'transaction is done';
+is $websocket, 0, 'no websocket';
+is $code, 500, 'right status';
+is $message, 'Internal Server Error', 'right message';
# WebSocket /foo (forbidden)
($websocket, $code, $message) = undef;
@@ -295,10 +302,10 @@ $client->websocket(
$code = $self->res->code;
$message = $self->res->message;
}
-)->process;
-is($websocket, 0, 'no websocket');
-is($code, 403, 'right status');
-is($message, "i'm a teapot", 'right message');
+)->start;
+is $websocket, 0, 'no websocket';
+is $code, 403, 'right status';
+is $message, "i'm a teapot", 'right message';
# WebSocket /deadcallback (dies in callback)
$client->websocket(
@@ -306,7 +313,7 @@ $client->websocket(
my $self = shift;
$self->send_message('test1');
}
-)->process;
+)->start;
# Server side "finished" callback
-is($flag, 24, 'finished callback');
+is $flag, 24, 'finished callback';
@@ -6,17 +6,12 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
-use Test::More;
-
-# Make sure sockets are working
-plan skip_all => 'working sockets required for this test!'
- unless my $proxy = Mojo::IOLoop->new->generate_port;
-plan tests => 9;
+use Test::More tests => 9;
# Your mistletoe is no match for my *tow* missile.
use Mojo::ByteStream 'b';
use Mojo::Client;
+use Mojo::IOLoop;
use Mojo::Server::Daemon;
use Mojolicious::Lite;
@@ -24,7 +19,12 @@ use Mojolicious::Lite;
app->log->level('fatal');
# GET /
-get '/' => sub { shift->render_text('Hello World!') };
+get '/' => sub {
+ my $self = shift;
+ my $rel = $self->req->url;
+ my $abs = $rel->to_abs;
+ $self->render_text("Hello World! $rel $abs");
+};
# GET /proxy
get '/proxy' => sub {
@@ -36,7 +36,7 @@ get '/proxy' => sub {
websocket '/test' => sub {
my $self = shift;
my $flag = 0;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$self->send_message("${message}test2");
@@ -54,14 +54,18 @@ $server->listen("http://*:$port");
$server->prepare_ioloop;
# Connect proxy server for testing
-my $c = {};
+my $proxy = Mojo::IOLoop->generate_port;
+my $c = {};
my $connected;
my ($read, $sent, $fail) = 0;
-my $nf = "HTTP/1.1 404 NOT FOUND\x0d\x0aConnection: close\x0d\x0a\x0d\x0a";
+my $nf =
+ "HTTP/1.1 404 NOT FOUND\x0d\x0a"
+ . "Content-Length: 0\x0d\x0a"
+ . "Connection: close\x0d\x0a\x0d\x0a";
my $ok = "HTTP/1.1 200 OK\x0d\x0aConnection: keep-alive\x0d\x0a\x0d\x0a";
$loop->listen(
port => $proxy,
- read_cb => sub {
+ on_read => sub {
my ($loop, $client, $chunk) = @_;
if (my $server = $c->{$client}->{connection}) {
return $loop->write($server, $chunk);
@@ -76,16 +80,16 @@ $loop->listen(
my $server = $loop->connect(
address => $1,
port => $fail ? $port : $2,
- connect_cb => sub {
+ on_connect => sub {
my ($loop, $server) = @_;
$c->{$client}->{connection} = $server;
$loop->write($client, $fail ? $nf : $ok);
},
- error_cb => sub {
+ on_error => sub {
shift->drop($client);
delete $c->{$client};
},
- read_cb => sub {
+ on_read => sub {
my ($loop, $server, $chunk) = @_;
$read += length $chunk;
$sent += length $chunk;
@@ -96,7 +100,7 @@ $loop->listen(
else { $loop->drop($client) }
}
},
- error_cb => sub {
+ on_error => sub {
my ($self, $client) = @_;
shift->drop($c->{$client}->{connection})
if $c->{$client}->{connection};
@@ -105,15 +109,15 @@ $loop->listen(
);
# GET / (normal request)
-is($client->get("http://localhost:$port/")->success->body,
- 'Hello World!', 'right content');
+is $client->get("http://localhost:$port/")->success->body,
+ "Hello World! / http://localhost:$port/", 'right content';
# WebSocket /test (normal websocket)
my $result;
$client->websocket(
"ws://localhost:$port/test" => sub {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -122,13 +126,13 @@ $client->websocket(
);
$self->send_message('test1');
}
-)->process;
-is($result, 'test1test2', 'right result');
+)->start;
+is $result, 'test1test2', 'right result';
# GET http://kraih.com/proxy (proxy request)
$client->http_proxy("http://localhost:$port");
-is($client->get("http://kraih.com/proxy")->success->body,
- 'http://kraih.com/proxy', 'right content');
+is $client->get("http://kraih.com/proxy")->success->body,
+ 'http://kraih.com/proxy', 'right content';
# WebSocket /test (proxy websocket)
$client->http_proxy("http://localhost:$proxy");
@@ -136,7 +140,7 @@ $result = undef;
$client->websocket(
"ws://localhost:$port/test" => sub {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -145,11 +149,11 @@ $client->websocket(
);
$self->send_message('test1');
}
-)->process;
-is($connected, "localhost:$port", 'connected');
-is($result, 'test1test2', 'right result');
-ok($read > 25, 'read enough');
-ok($sent > 25, 'sent enough');
+)->start;
+is $connected, "localhost:$port", 'connected';
+is $result, 'test1test2', 'right result';
+ok $read > 25, 'read enough';
+ok $sent > 25, 'sent enough';
# WebSocket /test (proxy websocket with bad target)
$client->http_proxy("http://localhost:$proxy");
@@ -161,6 +165,6 @@ $client->websocket(
$success = $tx->success;
$error = $tx->error;
}
-)->process;
-is($success, undef, 'no success');
-is($error, 'Proxy connection failed.', 'right message');
+)->start;
+is $success, undef, 'no success';
+is $error, 'Proxy connection failed.', 'right message';
@@ -6,14 +6,10 @@ use warnings;
# Disable epoll, kqueue and IPv6
BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_IPV6} = 1 }
-use Mojo::IOLoop;
use Test::More;
-
-# Make sure sockets are working
+use Mojo::IOLoop;
plan skip_all => 'IO::Socket::SSL 1.33 required for this test!'
unless Mojo::IOLoop::TLS;
-plan skip_all => 'working sockets required for this test!'
- unless my $proxy = Mojo::IOLoop->new->generate_port;
plan tests => 16;
# I was a hero to broken robots 'cause I was one of them, but how can I sing
@@ -29,7 +25,12 @@ use Mojolicious::Lite;
app->log->level('fatal');
# GET /
-get '/' => sub { shift->render_text('Hello World!') };
+get '/' => sub {
+ my $self = shift;
+ my $rel = $self->req->url;
+ my $abs = $rel->to_abs;
+ $self->render_text("Hello World! $rel $abs");
+};
# GET /proxy
get '/proxy' => sub {
@@ -41,7 +42,7 @@ get '/proxy' => sub {
websocket '/test' => sub {
my $self = shift;
my $flag = 0;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$self->send_message("${message}test2");
@@ -59,14 +60,18 @@ $server->listen("https://*:$port");
$server->prepare_ioloop;
# Connect proxy server for testing
-my $c = {};
+my $proxy = Mojo::IOLoop->generate_port;
+my $c = {};
my $connected;
my ($read, $sent, $fail) = 0;
-my $nf = "HTTP/1.1 404 NOT FOUND\x0d\x0aConnection: close\x0d\x0a\x0d\x0a";
+my $nf =
+ "HTTP/1.1 404 NOT FOUND\x0d\x0a"
+ . "Content-Length: 0\x0d\x0a"
+ . "Connection: close\x0d\x0a\x0d\x0a";
my $ok = "HTTP/1.1 200 OK\x0d\x0aConnection: keep-alive\x0d\x0a\x0d\x0a";
$loop->listen(
port => $proxy,
- read_cb => sub {
+ on_read => sub {
my ($loop, $client, $chunk) = @_;
if (my $server = $c->{$client}->{connection}) {
return $loop->write($server, $chunk);
@@ -81,16 +86,16 @@ $loop->listen(
my $server = $loop->connect(
address => $1,
port => $fail ? $port : $2,
- connect_cb => sub {
+ on_connect => sub {
my ($loop, $server) = @_;
$c->{$client}->{connection} = $server;
$loop->write($client, $fail ? $nf : $ok);
},
- error_cb => sub {
+ on_error => sub {
shift->drop($client);
delete $c->{$client};
},
- read_cb => sub {
+ on_read => sub {
my ($loop, $server, $chunk) = @_;
$read += length $chunk;
$sent += length $chunk;
@@ -101,7 +106,7 @@ $loop->listen(
else { $loop->drop($client) }
}
},
- error_cb => sub {
+ on_error => sub {
my ($self, $client) = @_;
shift->drop($c->{$client}->{connection})
if $c->{$client}->{connection};
@@ -110,15 +115,15 @@ $loop->listen(
);
# GET / (normal request)
-is($client->get("https://localhost:$port/")->success->body,
- 'Hello World!', 'right content');
+is $client->get("https://localhost:$port/")->success->body,
+ "Hello World! / https://localhost:$port/", 'right content';
# WebSocket /test (normal websocket)
my $result;
$client->websocket(
"wss://localhost:$port/test" => sub {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -127,22 +132,20 @@ $client->websocket(
);
$self->send_message('test1');
}
-)->process;
-is($result, 'test1test2', 'right result');
+)->start;
+is $result, 'test1test2', 'right result';
# GET /proxy (proxy request)
$client->https_proxy("http://localhost:$proxy");
-is( $client->get("https://localhost:$port/proxy")->success->body,
- "https://localhost:$port/proxy",
- 'right content'
-);
+is $client->get("https://localhost:$port/proxy")->success->body,
+ "https://localhost:$port/proxy", 'right content';
# GET /proxy (kept alive proxy request)
$client->https_proxy("http://localhost:$proxy");
my $tx = $client->build_tx(GET => "https://localhost:$port/proxy");
-$client->process($tx);
-is($tx->success->body, "https://localhost:$port/proxy", 'right content');
-is($tx->kept_alive, 1, 'kept alive');
+$client->start($tx);
+is $tx->success->body, "https://localhost:$port/proxy", 'right content';
+is $tx->kept_alive, 1, 'kept alive';
# WebSocket /test (kept alive proxy websocket)
$client->https_proxy("http://localhost:$proxy");
@@ -152,7 +155,7 @@ $client->websocket(
"wss://localhost:$port/test" => sub {
my $self = shift;
$kept_alive = $self->tx->kept_alive;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -161,12 +164,12 @@ $client->websocket(
);
$self->send_message('test1');
}
-)->process;
-is($kept_alive, 1, 'kept alive');
-is($connected, "localhost:$port", 'connected');
-is($result, 'test1test2', 'right result');
-ok($read > 25, 'read enough');
-ok($sent > 25, 'sent enough');
+)->start;
+is $kept_alive, 1, 'kept alive';
+is $connected, "localhost:$port", 'connected';
+is $result, 'test1test2', 'right result';
+ok $read > 25, 'read enough';
+ok $sent > 25, 'sent enough';
# WebSocket /test (proxy websocket)
$client->https_proxy("http://localhost:$proxy");
@@ -174,7 +177,7 @@ $client->https_proxy("http://localhost:$proxy");
$client->websocket(
"wss://localhost:$port/test" => sub {
my $self = shift;
- $self->receive_message(
+ $self->on_message(
sub {
my ($self, $message) = @_;
$result = $message;
@@ -183,11 +186,11 @@ $client->websocket(
);
$self->send_message('test1');
}
-)->process;
-is($connected, "localhost:$port", 'connected');
-is($result, 'test1test2', 'right result');
-ok($read > 25, 'read enough');
-ok($sent > 25, 'sent enough');
+)->start;
+is $connected, "localhost:$port", 'connected';
+is $result, 'test1test2', 'right result';
+ok $read > 25, 'read enough';
+ok $sent > 25, 'sent enough';
# WebSocket /test (proxy websocket with bad target)
$client->https_proxy("http://localhost:$proxy");
@@ -199,6 +202,6 @@ $client->websocket(
$success = $tx->success;
$error = $tx->error;
}
-)->process;
-is($success, undef, 'no success');
-is($error, 'Proxy connection failed.', 'right message');
+)->start;
+is $success, undef, 'no success';
+is $error, 'Proxy connection failed.', 'right message';
@@ -1,51 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 9;
-
-# Of all the parasites I've had over the years,
-# these worms are among the best.
-use MojoX::Dispatcher::Routes::Controller;
-
-my $c = MojoX::Dispatcher::Routes::Controller->new;
-
-# Set
-$c->stash(foo => 'bar');
-is($c->stash('foo'), 'bar', 'set and return a stash value');
-
-# Ref value
-my $stash = $c->stash;
-is_deeply($stash, {foo => 'bar'}, 'return a hashref');
-
-# Replace
-$c->stash(foo => 'baz');
-is($c->stash('foo'), 'baz', 'replace and return a stash value');
-
-# Set 0
-$c->stash(zero => 0);
-is($c->stash('zero'), 0, 'set and return 0 value');
-
-# Replace with 0
-$c->stash(foo => 0);
-is($c->stash('foo'), 0, 'replace and return 0 value');
-
-# Use 0 as key
-$c->stash(0 => 'boo');
-is($c->stash('0'), 'boo', 'set and get with 0 as key');
-
-# Delete
-$stash = $c->stash;
-delete $stash->{foo};
-delete $stash->{0};
-delete $stash->{zero};
-is_deeply($stash, {}, 'elements can be deleted');
-$c->stash('foo' => 'zoo');
-delete $c->stash->{foo};
-is_deeply($c->stash, {}, 'elements can be deleted');
-
-# Set via hash
-$c->stash({a => 1, b => 2});
-$stash = $c->stash;
-is_deeply($stash, {a => 1, b => 2}, 'set via hashref');
@@ -1,117 +0,0 @@
-#!/usr/bin/env perl
-
-package Test::Foo;
-
-use strict;
-use warnings;
-
-use base 'MojoX::Dispatcher::Routes::Controller';
-
-sub bar {1}
-sub home {1}
-
-package Test::Controller;
-
-use strict;
-use warnings;
-
-use base 'MojoX::Dispatcher::Routes::Controller';
-
-__PACKAGE__->attr('render_called');
-
-sub render { shift->render_called(1) }
-
-sub reset_state {
- my $self = shift;
- $self->render_called(0);
- my $stash = $self->stash;
- delete $stash->{$_} for keys %$stash;
-}
-
-# I was all of history's greatest acting robots -- Acting Unit 0.8,
-# Thespomat, David Duchovny!
-package main;
-
-use strict;
-use warnings;
-
-use utf8;
-
-use Test::More tests => 32;
-
-use Mojo;
-use Mojo::Transaction::HTTP;
-use MojoX::Dispatcher::Routes;
-
-my $c = Test::Controller->new(app => Mojo->new);
-
-# Silence
-$c->app->log->path(undef);
-$c->app->log->level('error');
-
-my $d = MojoX::Dispatcher::Routes->new;
-ok($d, 'initialized');
-
-$d->namespace('Test');
-$d->route('/')->to(controller => 'foo', action => 'home');
-$d->route('/foo/(capture)')->to(controller => 'foo', action => 'bar');
-
-# 404 clean stash
-$c->reset_state;
-my $tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/not_found');
-$c->tx($tx);
-is($d->dispatch($c), 1, 'dispatched');
-is_deeply($c->stash, {}, 'empty stash');
-ok(!$c->render_called, 'nothing rendered');
-
-# No escaping
-$c->reset_state;
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('POST');
-$tx->req->url->parse('/foo/hello');
-$c->tx($tx);
-$c->stash(test => 23);
-is($d->dispatch($c), '', 'dispatched');
-is($c->stash->{controller}, 'foo', 'right value');
-is($c->stash->{action}, 'bar', 'right value');
-is($c->stash->{capture}, 'hello', 'right value');
-is($c->stash->{test}, 23, 'right value');
-is(ref $c->stash->{'mojo.params'}, 'Mojo::Parameters', 'right parameters');
-is($c->param('controller'), 'foo', 'right value');
-is($c->param('action'), 'bar', 'right value');
-is($c->param('capture'), 'hello', 'right value');
-ok($c->render_called, 'rendered');
-
-# Escaping
-$c->reset_state;
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/foo/hello%20there');
-$c->tx($tx);
-is($d->dispatch($c), '', 'dispatched');
-is($c->stash->{controller}, 'foo', 'right value');
-is($c->stash->{action}, 'bar', 'right value');
-is($c->stash->{capture}, 'hello there', 'right value');
-is(ref $c->stash->{'mojo.params'}, 'Mojo::Parameters', 'right parameters');
-is($c->param('controller'), 'foo', 'right value');
-is($c->param('action'), 'bar', 'right value');
-is($c->param('capture'), 'hello there', 'right value');
-ok($c->render_called, 'rendered');
-
-# Escaping utf8
-$c->reset_state;
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/foo/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82');
-$c->tx($tx);
-is($d->dispatch($c), '', 'dispatched');
-is($c->stash->{controller}, 'foo', 'right value');
-is($c->stash->{action}, 'bar', 'right value');
-is($c->stash->{capture}, 'привет', 'right value');
-is(ref $c->stash->{'mojo.params'}, 'Mojo::Parameters', 'right parameters');
-is($c->param('controller'), 'foo', 'right value');
-is($c->param('action'), 'bar', 'right value');
-is($c->param('capture'), 'привет', 'right value');
-ok($c->render_called, 'rendered');
@@ -0,0 +1,156 @@
+#!/usr/bin/env perl
+
+package Test::Foo;
+
+use strict;
+use warnings;
+
+use base 'MojoX::Dispatcher::Routes::Controller';
+
+sub bar {1}
+sub home {1}
+
+package Test::Controller;
+
+use strict;
+use warnings;
+
+use base 'MojoX::Dispatcher::Routes::Controller';
+
+__PACKAGE__->attr('render_called');
+
+sub render { shift->render_called(1) }
+
+sub reset_state {
+ my $self = shift;
+ $self->render_called(0);
+ my $stash = $self->stash;
+ delete $stash->{$_} for keys %$stash;
+}
+
+# I was all of history's greatest acting robots -- Acting Unit 0.8,
+# Thespomat, David Duchovny!
+package main;
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 41;
+
+use Mojo;
+use Mojo::Transaction::HTTP;
+use MojoX::Dispatcher::Routes;
+use MojoX::Dispatcher::Routes::Controller;
+
+my $c = MojoX::Dispatcher::Routes::Controller->new;
+
+# Set
+$c->stash(foo => 'bar');
+is $c->stash('foo'), 'bar', 'set and return a stash value';
+
+# Ref value
+my $stash = $c->stash;
+is_deeply $stash, {foo => 'bar'}, 'return a hashref';
+
+# Replace
+$c->stash(foo => 'baz');
+is $c->stash('foo'), 'baz', 'replace and return a stash value';
+
+# Set 0
+$c->stash(zero => 0);
+is $c->stash('zero'), 0, 'set and return 0 value';
+
+# Replace with 0
+$c->stash(foo => 0);
+is $c->stash('foo'), 0, 'replace and return 0 value';
+
+# Use 0 as key
+$c->stash(0 => 'boo');
+is $c->stash('0'), 'boo', 'set and get with 0 as key';
+
+# Delete
+$stash = $c->stash;
+delete $stash->{foo};
+delete $stash->{0};
+delete $stash->{zero};
+is_deeply $stash, {}, 'elements can be deleted';
+$c->stash('foo' => 'zoo');
+delete $c->stash->{foo};
+is_deeply $c->stash, {}, 'elements can be deleted';
+
+# Set via hash
+$c->stash({a => 1, b => 2});
+$stash = $c->stash;
+is_deeply $stash, {a => 1, b => 2}, 'set via hashref';
+
+$c = Test::Controller->new(app => Mojo->new);
+$c->app->log->path(undef);
+$c->app->log->level('fatal');
+my $d = MojoX::Dispatcher::Routes->new;
+ok $d, 'initialized';
+
+$d->namespace('Test');
+$d->route('/')->to(controller => 'foo', action => 'home');
+$d->route('/foo/(capture)')->to(controller => 'foo', action => 'bar');
+
+# 404 clean stash
+$c->reset_state;
+my $tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/not_found');
+$c->tx($tx);
+is $d->dispatch($c), 1, 'dispatched';
+is_deeply $c->stash, {}, 'empty stash';
+ok !$c->render_called, 'nothing rendered';
+
+# No escaping
+$c->reset_state;
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('POST');
+$tx->req->url->parse('/foo/hello');
+$c->tx($tx);
+$c->stash(test => 23);
+is $d->dispatch($c), undef, 'dispatched';
+is $c->stash->{controller}, 'foo', 'right value';
+is $c->stash->{action}, 'bar', 'right value';
+is $c->stash->{capture}, 'hello', 'right value';
+is $c->stash->{test}, 23, 'right value';
+is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), 'hello', 'right value';
+ok $c->render_called, 'rendered';
+
+# Escaping
+$c->reset_state;
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/foo/hello%20there');
+$c->tx($tx);
+is $d->dispatch($c), undef, 'dispatched';
+is $c->stash->{controller}, 'foo', 'right value';
+is $c->stash->{action}, 'bar', 'right value';
+is $c->stash->{capture}, 'hello there', 'right value';
+is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), 'hello there', 'right value';
+ok $c->render_called, 'rendered';
+
+# Escaping utf8
+$c->reset_state;
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/foo/%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82');
+$c->tx($tx);
+is $d->dispatch($c), undef, 'dispatched';
+is $c->stash->{controller}, 'foo', 'right value';
+is $c->stash->{action}, 'bar', 'right value';
+is $c->stash->{capture}, 'привет', 'right value';
+is ref $c->stash->{'mojo.captures'}, 'HASH', 'right captures';
+is $c->param('controller'), 'foo', 'right value';
+is $c->param('action'), 'bar', 'right value';
+is $c->param('capture'), 'привет', 'right value';
+ok $c->render_called, 'rendered';
@@ -0,0 +1,99 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 38;
+
+# People said I was dumb, but I proved them.
+use_ok 'MojoX::Routes::Pattern';
+
+# Normal pattern with text, symbols and a default value
+my $pattern = MojoX::Routes::Pattern->new('/test/(controller)/:action');
+$pattern->defaults({action => 'index'});
+my $result = $pattern->match('/test/foo/bar');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar', 'right value';
+$result = $pattern->match('/test/foo');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'index', 'right value';
+$result = $pattern->match('/test/foo/');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'index', 'right value';
+$result = $pattern->match('/test/');
+is $result, undef, 'no result';
+is $pattern->render({controller => 'foo'}), '/test/foo', 'right result';
+
+# Root
+$pattern = MojoX::Routes::Pattern->new('/');
+$pattern->defaults({action => 'index'});
+$result = $pattern->match('/test/foo/bar');
+is $result, undef, 'no result';
+$result = $pattern->match('/');
+is $result->{action}, 'index', 'right value';
+is $pattern->render, '/', 'right result';
+
+# Regex in pattern
+$pattern =
+ MojoX::Routes::Pattern->new('/test/(controller)/:action/(id)', id => '\d+');
+$pattern->defaults({action => 'index', id => 1});
+$result = $pattern->match('/test/foo/bar/203');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar', 'right value';
+is $result->{id}, 203, 'right value';
+$result = $pattern->match('/test/foo/bar/baz');
+is_deeply $result, undef, 'no result';
+is $pattern->render({controller => 'zzz', action => 'index', id => 13}),
+ '/test/zzz/index/13', 'right result';
+is $pattern->render({controller => 'zzz'}), '/test/zzz', 'right result';
+
+# Quoted symbol
+$pattern = MojoX::Routes::Pattern->new('/(:controller)test/(action)');
+$pattern->defaults({action => 'index'});
+$result = $pattern->match('/footest/bar');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar', 'right value';
+is $pattern->render({controller => 'zzz', action => 'lala'}), '/zzztest/lala',
+ 'right result';
+$result = $pattern->match('/test/lala');
+is $result, undef, 'no result';
+
+# Format
+$pattern = MojoX::Routes::Pattern->new('/(controller)test/(action)');
+is $pattern->format, undef, 'no value';
+$pattern = MojoX::Routes::Pattern->new('/(:controller)test/:action.html');
+is $pattern->format, 'html', 'right value';
+$pattern = MojoX::Routes::Pattern->new('/index.cgi');
+is $pattern->format, 'cgi', 'right value';
+
+# Relaxed
+$pattern = MojoX::Routes::Pattern->new('/test/(.controller)/:action');
+$result = $pattern->match('/test/foo.bar/baz');
+is $result->{controller}, 'foo.bar', 'right value';
+is $result->{action}, 'baz', 'right value';
+is $pattern->render({controller => 'foo.bar', action => 'baz'}),
+ '/test/foo.bar/baz', 'right result';
+$pattern = MojoX::Routes::Pattern->new('/test/(.groovy)');
+$result = $pattern->match('/test/foo.bar');
+is $pattern->format, undef, 'no value';
+is $result->{groovy}, 'foo.bar', 'right value';
+is $result->{format}, undef, 'no value';
+is $pattern->render({groovy => 'foo.bar'}), '/test/foo.bar', 'right result';
+
+# Wildcard
+$pattern = MojoX::Routes::Pattern->new('/test/(:controller)/(*action)');
+$result = $pattern->match('/test/foo/bar.baz/yada');
+is $result->{controller}, 'foo', 'right value';
+is $result->{action}, 'bar.baz/yada', 'right value';
+is $pattern->render({controller => 'foo', action => 'bar.baz/yada'}),
+ '/test/foo/bar.baz/yada', 'right result';
+
+# Render false value
+$pattern = MojoX::Routes::Pattern->new('/:id');
+is $pattern->render({id => 0}), '/0', 'right result';
+
+# Regex in path
+$pattern = MojoX::Routes::Pattern->new('/:test');
+$result = $pattern->match('/test(test)(\Qtest\E)(');
+is $result->{test}, 'test(test)(\Qtest\E)(', 'right value';
+is $pattern->render({test => '23'}), '/23', 'right result';
@@ -26,29 +26,22 @@ $c->stash->{format} = 'something';
# Normal rendering
$c->stash->{template} = 'something';
$c->stash->{handler} = 'debug';
-is_deeply([$r->render($c)], ['Hello Mojo!', 'text/plain'],
- 'normal rendering');
+is_deeply [$r->render($c)], ['Hello Mojo!', 'text/plain'], 'normal rendering';
# Normal rendering with layout
$c->stash->{template} = 'something';
$c->stash->{layout} = 'something';
$c->stash->{handler} = 'debug';
-is_deeply(
- [$r->render($c)],
- ['Hello Mojo!Hello Mojo!', 'text/plain'],
- 'normal rendering with layout'
-);
-is(delete $c->stash->{layout}, 'something');
+is_deeply [$r->render($c)], ['Hello Mojo!Hello Mojo!', 'text/plain'],
+ 'normal rendering with layout';
+is delete $c->stash->{layout}, 'something';
# Rendering a path with dots
$c->stash->{template} = 'some.path.with.dots/template';
$c->stash->{handler} = 'debug';
-is_deeply(
- [$r->render($c)],
- ['Hello Mojo!', 'text/plain'],
- 'rendering a path with dots'
-);
+is_deeply [$r->render($c)], ['Hello Mojo!', 'text/plain'],
+ 'rendering a path with dots';
# Unrecognized handler
$c->stash->{handler} = 'not_defined';
-is($r->render($c), undef, 'return undef for unrecognized handler');
+is $r->render($c), undef, 'return undef for unrecognized handler';
@@ -1,93 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 36;
-
-# People said I was dumb, but I proved them.
-use_ok('MojoX::Routes::Pattern');
-
-# Normal pattern with text, symbols and a default value
-my $pattern = MojoX::Routes::Pattern->new('/test/(controller)/:action');
-$pattern->defaults({action => 'index'});
-my $result = $pattern->match('/test/foo/bar');
-is($result->{controller}, 'foo', 'right value');
-is($result->{action}, 'bar', 'right value');
-$result = $pattern->match('/test/foo');
-is($result->{controller}, 'foo', 'right value');
-is($result->{action}, 'index', 'right value');
-$result = $pattern->match('/test/foo/');
-is($result->{controller}, 'foo', 'right value');
-is($result->{action}, 'index', 'right value');
-$result = $pattern->match('/test/');
-is($result, undef, 'no result');
-is($pattern->render({controller => 'foo'}), '/test/foo', 'right result');
-
-# Root
-$pattern = MojoX::Routes::Pattern->new('/');
-$pattern->defaults({action => 'index'});
-$result = $pattern->match('/test/foo/bar');
-is($result, undef, 'no result');
-$result = $pattern->match('/');
-is($result->{action}, 'index', 'right value');
-is($pattern->render, '/', 'right result');
-
-# Regex in pattern
-$pattern =
- MojoX::Routes::Pattern->new('/test/(controller)/:action/(id)', id => '\d+');
-$pattern->defaults({action => 'index', id => 1});
-$result = $pattern->match('/test/foo/bar/203');
-is($result->{controller}, 'foo', 'right value');
-is($result->{action}, 'bar', 'right value');
-is($result->{id}, 203, 'right value');
-$result = $pattern->match('/test/foo/bar/baz');
-is_deeply($result, undef, 'no result');
-is($pattern->render({controller => 'zzz', action => 'index', id => 13}),
- '/test/zzz/index/13', 'right result');
-is($pattern->render({controller => 'zzz'}), '/test/zzz', 'right result');
-
-# Quoted symbol
-$pattern = MojoX::Routes::Pattern->new('/(:controller)test/(action)');
-$pattern->defaults({action => 'index'});
-$result = $pattern->match('/footest/bar');
-is($result->{controller}, 'foo', 'right value');
-is($result->{action}, 'bar', 'right value');
-is($pattern->render({controller => 'zzz', action => 'lala'}),
- '/zzztest/lala', 'right result');
-$result = $pattern->match('/test/lala');
-is($result, undef, 'no result');
-
-# Format
-$pattern = MojoX::Routes::Pattern->new('/(controller)test/(action)');
-is($pattern->format, undef, 'no value');
-$pattern = MojoX::Routes::Pattern->new('/(:controller)test/:action.html');
-is($pattern->format, 'html', 'right value');
-$pattern = MojoX::Routes::Pattern->new('/index.cgi');
-is($pattern->format, 'cgi', 'right value');
-
-# Relaxed
-$pattern = MojoX::Routes::Pattern->new('/test/(.controller)/:action');
-$result = $pattern->match('/test/foo.bar/baz');
-is($result->{controller}, 'foo.bar', 'right value');
-is($result->{action}, 'baz', 'right value');
-is($pattern->render({controller => 'foo.bar', action => 'baz'}),
- '/test/foo.bar/baz', 'right result');
-$pattern = MojoX::Routes::Pattern->new('/test/(.groovy)');
-$result = $pattern->match('/test/foo.bar');
-is($pattern->format, undef, 'no value');
-is($result->{groovy}, 'foo.bar', 'right value');
-is($result->{format}, undef, 'no value');
-is($pattern->render({groovy => 'foo.bar'}), '/test/foo.bar', 'right result');
-
-# Wildcard
-$pattern = MojoX::Routes::Pattern->new('/test/(:controller)/(*action)');
-$result = $pattern->match('/test/foo/bar.baz/yada');
-is($result->{controller}, 'foo', 'right value');
-is($result->{action}, 'bar.baz/yada', 'right value');
-is($pattern->render({controller => 'foo', action => 'bar.baz/yada'}),
- '/test/foo/bar.baz/yada', 'right result');
-
-# Render false value
-$pattern = MojoX::Routes::Pattern->new('/:id');
-is($pattern->render({id => 0}), '/0', 'right result');
@@ -1,502 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 193;
-
-use Mojo::Transaction::HTTP;
-
-# They're not very heavy, but you don't hear me not complaining.
-use_ok('MojoX::Routes');
-use_ok('MojoX::Routes::Match');
-
-# Routes
-my $r = MojoX::Routes->new;
-
-# /clean
-$r->route('/clean')->to(clean => 1);
-
-# /clean/too
-$r->route('/clean/too')->to(something => 1);
-
-# /*/test
-my $test = $r->route('/:controller/test')->to(action => 'test');
-
-# /*/test/edit
-$test->route('/edit')->to(action => 'edit')->name('test_edit');
-
-# /*/test/delete/*
-$test->route('/delete/(id)', id => qr/\d+/)->to(action => 'delete', id => 23);
-
-# /test2
-my $test2 = $r->bridge('/test2')->to(controller => 'test2');
-
-# /test2 (inline)
-my $test4 = $test2->bridge->to(controller => 'index');
-
-# /test2/foo
-$test4->route('/foo')->to(controller => 'baz');
-
-# /test2/bar
-$test4->route('/bar')->to(controller => 'lalala');
-
-# /test2/baz
-$test2->route('/baz')->to('just#works');
-
-# /test3
-my $test3 = $r->waypoint('/test3')->to(controller => 's', action => 'l');
-
-# /test3/edit
-$test3->route('/edit')->to(action => 'edit');
-
-# /
-$r->route('/')->to(controller => 'hello', action => 'world');
-
-# /wildcards/1/*
-$r->route('/wildcards/1/(*wildcard)', wildcard => qr/(.*)/)
- ->to(controller => 'wild', action => 'card');
-
-# /wildcards/2/*
-$r->route('/wildcards/2/(*wildcard)')
- ->to(controller => 'card', action => 'wild');
-
-# /wildcards/3/*/foo
-$r->route('/wildcards/3/(*wildcard)/foo')
- ->to(controller => 'very', action => 'dangerous');
-
-# /format
-# /format.html
-$r->route('/format')
- ->to(controller => 'hello', action => 'you', format => 'html');
-
-# /format2.html
-$r->route('/format2.html')->to(controller => 'you', action => 'hello');
-
-# /format2.json
-$r->route('/format2.json')->to(controller => 'you', action => 'hello_json');
-
-# /format3/*.html
-$r->route('/format3/:foo.html')->to(controller => 'me', action => 'bye');
-
-# /format3/*.json
-$r->route('/format3/:foo.json')->to(controller => 'me', action => 'bye_json');
-
-# /articles
-# /articles.html
-# /articles/1
-# /articles/1.html
-# /articles/1/edit
-# /articles/1/delete
-my $articles = $r->waypoint('/articles')->to(
- controller => 'articles',
- action => 'index',
- format => 'html'
-);
-my $wp = $articles->waypoint('/:id')->to(
- controller => 'articles',
- action => 'load',
- format => 'html'
-);
-my $bridge = $wp->bridge->to(
- controller => 'articles',
- action => 'load',
- format => 'html'
-);
-$bridge->route('/edit')->to(controller => 'articles', action => 'edit');
-$bridge->route('/delete')->to(
- controller => 'articles',
- action => 'delete',
- format => undef
-)->name('articles_delete');
-
-# GET /method/get
-$r->route('/method/get')->via('GET')
- ->to(controller => 'method', action => 'get');
-
-# POST /method/post
-$r->route('/method/post')->via('post')
- ->to(controller => 'method', action => 'post');
-
-# POST|GET /method/post_get
-$r->route('/method/post_get')->via(qw/POST get/)
- ->to(controller => 'method', action => 'post_get');
-
-# /simple/form
-$r->route('/simple/form')->to('test-test#test');
-
-# /edge/gift
-my $edge = $r->route('/edge');
-my $auth = $edge->bridge('/auth')->to('auth#check');
-$auth->route('/about/')->to('pref#about');
-$auth->bridge->to('album#allow')->route('/album/create/')->to('album#create');
-$auth->route('/gift/')->to('gift#index');
-
-# Make sure stash stays clean
-my $tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/clean');
-my $m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{clean}, 1, 'right value');
-is($m->stack->[0]->{something}, undef, 'no value');
-is($m->url_for, '/clean', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/clean/too');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{clean}, undef, 'no value');
-is($m->stack->[0]->{something}, 1, 'right value');
-is($m->url_for, '/clean/too', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Real world example using most features at once
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'articles', 'right value');
-is($m->stack->[0]->{action}, 'index', 'right value');
-is($m->stack->[0]->{format}, 'html', 'right value');
-is($m->url_for, '/articles.html', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles/1.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'articles', 'right value');
-is($m->stack->[0]->{action}, 'load', 'right value');
-is($m->stack->[0]->{id}, '1', 'right value');
-is($m->stack->[0]->{format}, 'html', 'right value');
-is($m->url_for, '/articles/1.html', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles/1/edit');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[1]->{controller}, 'articles', 'right value');
-is($m->stack->[1]->{action}, 'edit', 'right value');
-is($m->stack->[1]->{format}, 'html', 'right value');
-is($m->url_for, '/articles/1/edit.html', 'right URL');
-is($m->url_for('articles_delete', format => undef),
- '/articles/1/delete', 'right URL');
-is(@{$m->stack}, 2, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/articles/1/delete');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[1]->{controller}, 'articles', 'right value');
-is($m->stack->[1]->{action}, 'delete', 'right value');
-is($m->stack->[1]->{format}, undef, 'no value');
-is($m->url_for, '/articles/1/delete', 'right URL');
-is(@{$m->stack}, 2, 'right number of elements');
-
-# Root
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->captures->{controller}, 'hello', 'right value');
-is($m->captures->{action}, 'world', 'right value');
-is($m->stack->[0]->{controller}, 'hello', 'right value');
-is($m->stack->[0]->{action}, 'world', 'right value');
-is($m->url_for, '/', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Path and captures
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/foo/test/edit');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->captures->{controller}, 'foo', 'right value');
-is($m->captures->{action}, 'edit', 'right value');
-is($m->stack->[0]->{controller}, 'foo', 'right value');
-is($m->stack->[0]->{action}, 'edit', 'right value');
-is($m->url_for, '/foo/test/edit', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Optional captures in sub route with requirement
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/bar/test/delete/22');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->captures->{controller}, 'bar', 'right value');
-is($m->captures->{action}, 'delete', 'right value');
-is($m->captures->{id}, 22, 'right value');
-is($m->stack->[0]->{controller}, 'bar', 'right value');
-is($m->stack->[0]->{action}, 'delete', 'right value');
-is($m->stack->[0]->{id}, 22, 'right value');
-is($m->url_for, '/bar/test/delete/22', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Defaults in sub route
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/bar/test/delete');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->captures->{controller}, 'bar', 'right value');
-is($m->captures->{action}, 'delete', 'right value');
-is($m->captures->{id}, 23, 'right value');
-is($m->stack->[0]->{controller}, 'bar', 'right value');
-is($m->stack->[0]->{action}, 'delete', 'right value');
-is($m->stack->[0]->{id}, 23, 'right value');
-is($m->url_for, '/bar/test/delete', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Chained routes
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test2/foo');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'test2', 'right value');
-is($m->stack->[1]->{controller}, 'index', 'right value');
-is($m->stack->[2]->{controller}, 'baz', 'right value');
-is($m->captures->{controller}, 'baz', 'right value');
-is($m->url_for, '/test2/foo', 'right URL');
-is(@{$m->stack}, 3, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test2/bar');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'test2', 'right value');
-is($m->stack->[1]->{controller}, 'index', 'right value');
-is($m->stack->[2]->{controller}, 'lalala', 'right value');
-is($m->captures->{controller}, 'lalala', 'right value');
-is($m->url_for, '/test2/bar', 'right URL');
-is(@{$m->stack}, 3, 'right number of elements');
-$tx->req->url->parse('/test2/baz');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'test2', 'right value');
-is($m->stack->[1]->{controller}, 'just', 'right value');
-is($m->stack->[1]->{action}, 'works', 'right value');
-is($m->stack->[2], undef, 'no value');
-is($m->captures->{controller}, 'just', 'right value');
-is($m->url_for, '/test2/baz', 'right URL');
-is(@{$m->stack}, 2, 'right number of elements');
-
-# Waypoints
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 's', 'right value');
-is($m->stack->[0]->{action}, 'l', 'right value');
-is($m->url_for, '/test3', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3/');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 's', 'right value');
-is($m->stack->[0]->{action}, 'l', 'right value');
-is($m->url_for, '/test3', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3/edit');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 's', 'right value');
-is($m->stack->[0]->{action}, 'edit', 'right value');
-is($m->url_for, '/test3/edit', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Named url_for
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/test3');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->url_for, '/test3', 'right URL');
-is($m->url_for('test_edit', controller => 'foo'),
- '/foo/test/edit', 'right URL');
-is($m->url_for('test_edit', {controller => 'foo'}),
- '/foo/test/edit', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Wildcards
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/1/hello/there');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'wild', 'right value');
-is($m->stack->[0]->{action}, 'card', 'right value');
-is($m->stack->[0]->{wildcard}, 'hello/there', 'right value');
-is($m->url_for, '/wildcards/1/hello/there', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/2/hello/there');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'card', 'right value');
-is($m->stack->[0]->{action}, 'wild', 'right value');
-is($m->stack->[0]->{wildcard}, 'hello/there', 'right value');
-is($m->url_for, '/wildcards/2/hello/there', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/3/hello/there/foo');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'very', 'right value');
-is($m->stack->[0]->{action}, 'dangerous', 'right value');
-is($m->stack->[0]->{wildcard}, 'hello/there', 'right value');
-is($m->url_for, '/wildcards/3/hello/there/foo', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Escaped
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/1/http://www.google.com');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'wild', 'right value');
-is($m->stack->[0]->{action}, 'card', 'right value');
-is($m->stack->[0]->{wildcard}, 'http:/www.google.com', 'right value');
-is($m->url_for, '/wildcards/1/http:/www.google.com', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/wildcards/1/http%3A%2F%2Fwww.google.com');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'wild', 'right value');
-is($m->stack->[0]->{action}, 'card', 'right value');
-is($m->stack->[0]->{wildcard}, 'http://www.google.com', 'right value');
-is($m->url_for, '/wildcards/1/http:/www.google.com', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Format
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'hello', 'right value');
-is($m->stack->[0]->{action}, 'you', 'right value');
-is($m->stack->[0]->{format}, 'html', 'right value');
-is($m->url_for, '/format.html', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'hello', 'right value');
-is($m->stack->[0]->{action}, 'you', 'right value');
-is($m->stack->[0]->{format}, 'html', 'right value');
-is($m->url_for, '/format.html', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format2.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'you', 'right value');
-is($m->stack->[0]->{action}, 'hello', 'right value');
-is($m->stack->[0]->{format}, 'html', 'right value');
-is($m->url_for, '/format2.html', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format2.json');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'you', 'right value');
-is($m->stack->[0]->{action}, 'hello_json', 'right value');
-is($m->stack->[0]->{format}, 'json', 'right value');
-is($m->url_for, '/format2.json', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format3/baz.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'me', 'right value');
-is($m->stack->[0]->{action}, 'bye', 'right value');
-is($m->stack->[0]->{format}, 'html', 'right value');
-is($m->stack->[0]->{foo}, 'baz', 'right value');
-is($m->url_for, '/format3/baz.html', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/format3/baz.json');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'me', 'right value');
-is($m->stack->[0]->{action}, 'bye_json', 'right value');
-is($m->stack->[0]->{format}, 'json', 'right value');
-is($m->stack->[0]->{foo}, 'baz', 'right value');
-is($m->url_for, '/format3/baz.json', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Request methods
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/method/get.html');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'method', 'right value');
-is($m->stack->[0]->{action}, 'get', 'right value');
-is($m->stack->[0]->{format}, 'html', 'right value');
-is($m->url_for, '/method/get.html', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('POST');
-$tx->req->url->parse('/method/post');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'method', 'right value');
-is($m->stack->[0]->{action}, 'post', 'right value');
-is($m->stack->[0]->{format}, undef, 'no value');
-is($m->url_for, '/method/post', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/method/post_get');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'method', 'right value');
-is($m->stack->[0]->{action}, 'post_get', 'right value');
-is($m->stack->[0]->{format}, undef, 'no value');
-is($m->url_for, '/method/post_get', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('POST');
-$tx->req->url->parse('/method/post_get');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'method', 'right value');
-is($m->stack->[0]->{action}, 'post_get', 'right value');
-is($m->stack->[0]->{format}, undef, 'no value');
-is($m->url_for, '/method/post_get', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('DELETE');
-$tx->req->url->parse('/method/post_get');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, undef, 'no value');
-is($m->stack->[0]->{action}, undef, 'no value');
-is($m->stack->[0]->{format}, undef, 'no value');
-is($m->url_for, '', 'no URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Not found
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/not_found');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->url_for('test_edit', controller => 'foo'),
- '/foo/test/edit', 'right URL');
-is(@{$m->stack}, 0, 'no elements');
-
-# Simplified form
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/simple/form');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'test-test', 'right value');
-is($m->stack->[0]->{action}, 'test', 'right value');
-is($m->stack->[0]->{format}, undef, 'no value');
-is($m->url_for, '/simple/form', 'right URL');
-is(@{$m->stack}, 1, 'right number of elements');
-
-# Special edge case with nested bridges
-$tx = Mojo::Transaction::HTTP->new;
-$tx->req->method('GET');
-$tx->req->url->parse('/edge/auth/gift');
-$m = MojoX::Routes::Match->new($tx)->match($r);
-is($m->stack->[0]->{controller}, 'auth', 'right value');
-is($m->stack->[0]->{action}, 'check', 'right value');
-is($m->stack->[0]->{format}, undef, 'no value');
-is($m->stack->[1]->{controller}, 'gift', 'right value');
-is($m->stack->[1]->{action}, 'index', 'right value');
-is($m->stack->[1]->{format}, undef, 'no value');
-is($m->stack->[2], undef, 'no value');
-is($m->url_for, '/edge/auth/gift', 'right URL');
-is(@{$m->stack}, 2, 'right number of elements');
@@ -0,0 +1,515 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 205;
+
+use Mojo::Transaction::HTTP;
+
+# They're not very heavy, but you don't hear me not complaining.
+use_ok 'MojoX::Routes';
+use_ok 'MojoX::Routes::Match';
+
+# Routes
+my $r = MojoX::Routes->new;
+
+# /clean
+$r->route('/clean')->to(clean => 1);
+
+# /clean/too
+$r->route('/clean/too')->to(something => 1);
+
+# /*/test
+my $test = $r->route('/:controller/test')->to(action => 'test');
+
+# /*/test/edit
+$test->route('/edit')->to(action => 'edit')->name('test_edit');
+
+# /*/test/delete/*
+$test->route('/delete/(id)', id => qr/\d+/)->to(action => 'delete', id => 23);
+
+# /test2
+my $test2 = $r->bridge('/test2')->to(controller => 'test2');
+
+# /test2 (inline)
+my $test4 = $test2->bridge->to(controller => 'index');
+
+# /test2/foo
+$test4->route('/foo')->to(controller => 'baz');
+
+# /test2/bar
+$test4->route('/bar')->to(controller => 'lalala');
+
+# /test2/baz
+$test2->route('/baz')->to('just#works');
+
+# /test3
+my $test3 = $r->waypoint('/test3')->to(controller => 's', action => 'l');
+
+# /test3/edit
+$test3->route('/edit')->to(action => 'edit');
+
+# /
+$r->route('/')->to(controller => 'hello', action => 'world');
+
+# /wildcards/1/*
+$r->route('/wildcards/1/(*wildcard)', wildcard => qr/(.*)/)
+ ->to(controller => 'wild', action => 'card');
+
+# /wildcards/2/*
+$r->route('/wildcards/2/(*wildcard)')
+ ->to(controller => 'card', action => 'wild');
+
+# /wildcards/3/*/foo
+$r->route('/wildcards/3/(*wildcard)/foo')
+ ->to(controller => 'very', action => 'dangerous');
+
+# /format
+# /format.html
+$r->route('/format')
+ ->to(controller => 'hello', action => 'you', format => 'html');
+
+# /format2.html
+$r->route('/format2.html')->to(controller => 'you', action => 'hello');
+
+# /format2.json
+$r->route('/format2.json')->to(controller => 'you', action => 'hello_json');
+
+# /format3/*.html
+$r->route('/format3/:foo.html')->to(controller => 'me', action => 'bye');
+
+# /format3/*.json
+$r->route('/format3/:foo.json')->to(controller => 'me', action => 'bye_json');
+
+# /articles
+# /articles.html
+# /articles/1
+# /articles/1.html
+# /articles/1/edit
+# /articles/1/delete
+my $articles = $r->waypoint('/articles')->to(
+ controller => 'articles',
+ action => 'index',
+ format => 'html'
+);
+my $wp = $articles->waypoint('/:id')->to(
+ controller => 'articles',
+ action => 'load',
+ format => 'html'
+);
+my $bridge = $wp->bridge->to(
+ controller => 'articles',
+ action => 'load',
+ format => 'html'
+);
+$bridge->route('/edit')->to(controller => 'articles', action => 'edit');
+$bridge->route('/delete')->to(
+ controller => 'articles',
+ action => 'delete',
+ format => undef
+)->name('articles_delete');
+
+# GET /method/get
+$r->route('/method/get')->via('GET')
+ ->to(controller => 'method', action => 'get');
+
+# POST /method/post
+$r->route('/method/post')->via('post')
+ ->to(controller => 'method', action => 'post');
+
+# POST|GET /method/post_get
+$r->route('/method/post_get')->via(qw/POST get/)
+ ->to(controller => 'method', action => 'post_get');
+
+# /simple/form
+$r->route('/simple/form')->to('test-test#test');
+
+# /edge/gift
+my $edge = $r->route('/edge');
+my $auth = $edge->bridge('/auth')->to('auth#check');
+$auth->route('/about/')->to('pref#about');
+$auth->bridge->to('album#allow')->route('/album/create/')->to('album#create');
+$auth->route('/gift/')->to('gift#index')->name('gift');
+
+# Make sure stash stays clean
+my $tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/clean');
+my $m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{clean}, 1, 'right value';
+is $m->stack->[0]->{something}, undef, 'no value';
+is $m->url_for, '/clean', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/clean/too');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{clean}, undef, 'no value';
+is $m->stack->[0]->{something}, 1, 'right value';
+is $m->url_for, '/clean/too', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Real world example using most features at once
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles.html');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'articles', 'right value';
+is $m->stack->[0]->{action}, 'index', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/articles', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles/1.html');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'articles', 'right value';
+is $m->stack->[0]->{action}, 'load', 'right value';
+is $m->stack->[0]->{id}, '1', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for(format => 'html'), '/articles/1.html', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles/1/edit');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[1]->{controller}, 'articles', 'right value';
+is $m->stack->[1]->{action}, 'edit', 'right value';
+is $m->stack->[1]->{format}, 'html', 'right value';
+is $m->url_for, '/articles/1/edit', 'right URL';
+is $m->url_for(format => 'html'), '/articles/1/edit.html', 'right URL';
+is $m->url_for('articles_delete', format => undef), '/articles/delete',
+ 'right URL';
+is $m->url_for('articles_delete'), '/articles/delete', 'right URL';
+is $m->url_for('articles_delete', id => 12), '/articles/12/delete',
+ 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/articles/1/delete');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[1]->{controller}, 'articles', 'right value';
+is $m->stack->[1]->{action}, 'delete', 'right value';
+is $m->stack->[1]->{format}, undef, 'no value';
+is $m->url_for, '/articles/1/delete', 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
+
+# Root
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'hello', 'right value';
+is $m->captures->{action}, 'world', 'right value';
+is $m->stack->[0]->{controller}, 'hello', 'right value';
+is $m->stack->[0]->{action}, 'world', 'right value';
+is $m->url_for, '/', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Path and captures
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/foo/test/edit');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'foo', 'right value';
+is $m->captures->{action}, 'edit', 'right value';
+is $m->stack->[0]->{controller}, 'foo', 'right value';
+is $m->stack->[0]->{action}, 'edit', 'right value';
+is $m->url_for, '/foo/test/edit', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Optional captures in sub route with requirement
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/bar/test/delete/22');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'bar', 'right value';
+is $m->captures->{action}, 'delete', 'right value';
+is $m->captures->{id}, 22, 'right value';
+is $m->stack->[0]->{controller}, 'bar', 'right value';
+is $m->stack->[0]->{action}, 'delete', 'right value';
+is $m->stack->[0]->{id}, 22, 'right value';
+is $m->url_for, '/bar/test/delete/22', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Defaults in sub route
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/bar/test/delete');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->captures->{controller}, 'bar', 'right value';
+is $m->captures->{action}, 'delete', 'right value';
+is $m->captures->{id}, 23, 'right value';
+is $m->stack->[0]->{controller}, 'bar', 'right value';
+is $m->stack->[0]->{action}, 'delete', 'right value';
+is $m->stack->[0]->{id}, 23, 'right value';
+is $m->url_for, '/bar/test/delete', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Chained routes
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test2/foo');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test2', 'right value';
+is $m->stack->[1]->{controller}, 'index', 'right value';
+is $m->stack->[2]->{controller}, 'baz', 'right value';
+is $m->captures->{controller}, 'baz', 'right value';
+is $m->url_for, '/test2/foo', 'right URL';
+is @{$m->stack}, 3, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test2/bar');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test2', 'right value';
+is $m->stack->[1]->{controller}, 'index', 'right value';
+is $m->stack->[2]->{controller}, 'lalala', 'right value';
+is $m->captures->{controller}, 'lalala', 'right value';
+is $m->url_for, '/test2/bar', 'right URL';
+is @{$m->stack}, 3, 'right number of elements';
+$tx->req->url->parse('/test2/baz');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test2', 'right value';
+is $m->stack->[1]->{controller}, 'just', 'right value';
+is $m->stack->[1]->{action}, 'works', 'right value';
+is $m->stack->[2], undef, 'no value';
+is $m->captures->{controller}, 'just', 'right value';
+is $m->url_for, '/test2/baz', 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
+
+# Waypoints
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 's', 'right value';
+is $m->stack->[0]->{action}, 'l', 'right value';
+is $m->url_for, '/test3', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3/');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 's', 'right value';
+is $m->stack->[0]->{action}, 'l', 'right value';
+is $m->url_for, '/test3', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3/edit');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 's', 'right value';
+is $m->stack->[0]->{action}, 'edit', 'right value';
+is $m->url_for, '/test3/edit', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Named url_for
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/test3');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->url_for, '/test3', 'right URL';
+is $m->url_for('test_edit', controller => 'foo'), '/foo/test/edit',
+ 'right URL';
+is $m->url_for('test_edit', {controller => 'foo'}), '/foo/test/edit',
+ 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Wildcards
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/1/hello/there');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'wild', 'right value';
+is $m->stack->[0]->{action}, 'card', 'right value';
+is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
+is $m->url_for, '/wildcards/1/hello/there', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/2/hello/there');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'card', 'right value';
+is $m->stack->[0]->{action}, 'wild', 'right value';
+is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
+is $m->url_for, '/wildcards/2/hello/there', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/3/hello/there/foo');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'very', 'right value';
+is $m->stack->[0]->{action}, 'dangerous', 'right value';
+is $m->stack->[0]->{wildcard}, 'hello/there', 'right value';
+is $m->url_for, '/wildcards/3/hello/there/foo', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Escaped
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/1/http://www.google.com');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'wild', 'right value';
+is $m->stack->[0]->{action}, 'card', 'right value';
+is $m->stack->[0]->{wildcard}, 'http://www.google.com', 'right value';
+is $m->url_for, '/wildcards/1/http://www.google.com', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/wildcards/1/http%3A%2F%2Fwww.google.com');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'wild', 'right value';
+is $m->stack->[0]->{action}, 'card', 'right value';
+is $m->stack->[0]->{wildcard}, 'http://www.google.com', 'right value';
+is $m->url_for, '/wildcards/1/http://www.google.com', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Format
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'hello', 'right value';
+is $m->stack->[0]->{action}, 'you', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/format', 'right URL';
+is $m->url_for(format => undef), '/format', 'right URL';
+is $m->url_for(format => 'html'), '/format.html', 'right URL';
+is $m->url_for(format => 'txt'), '/format.txt', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format.html');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'hello', 'right value';
+is $m->stack->[0]->{action}, 'you', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/format', 'right URL';
+is $m->url_for(format => undef), '/format', 'right URL';
+is $m->url_for(format => 'html'), '/format.html', 'right URL';
+is $m->url_for(format => 'txt'), '/format.txt', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format2.html');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'you', 'right value';
+is $m->stack->[0]->{action}, 'hello', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/format2.html', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format2.json');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'you', 'right value';
+is $m->stack->[0]->{action}, 'hello_json', 'right value';
+is $m->stack->[0]->{format}, 'json', 'right value';
+is $m->url_for, '/format2.json', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format3/baz.html');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'me', 'right value';
+is $m->stack->[0]->{action}, 'bye', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->stack->[0]->{foo}, 'baz', 'right value';
+is $m->url_for, '/format3/baz.html', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/format3/baz.json');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'me', 'right value';
+is $m->stack->[0]->{action}, 'bye_json', 'right value';
+is $m->stack->[0]->{format}, 'json', 'right value';
+is $m->stack->[0]->{foo}, 'baz', 'right value';
+is $m->url_for, '/format3/baz.json', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Request methods
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/method/get.html');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'get', 'right value';
+is $m->stack->[0]->{format}, 'html', 'right value';
+is $m->url_for, '/method/get', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('POST');
+$tx->req->url->parse('/method/post');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'post', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/method/post', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/method/post_get');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'post_get', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/method/post_get', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('POST');
+$tx->req->url->parse('/method/post_get');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'method', 'right value';
+is $m->stack->[0]->{action}, 'post_get', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/method/post_get', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('DELETE');
+$tx->req->url->parse('/method/post_get');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, undef, 'no value';
+is $m->stack->[0]->{action}, undef, 'no value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '', 'no URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Not found
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/not_found');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->url_for('test_edit', controller => 'foo'), '/foo/test/edit',
+ 'right URL';
+is @{$m->stack}, 0, 'no elements';
+
+# Simplified form
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/simple/form');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'test-test', 'right value';
+is $m->stack->[0]->{action}, 'test', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->url_for, '/simple/form', 'right URL';
+is $m->url_for('current'), '/simple/form', 'right URL';
+is @{$m->stack}, 1, 'right number of elements';
+
+# Special edge case with nested bridges
+$tx = Mojo::Transaction::HTTP->new;
+$tx->req->method('GET');
+$tx->req->url->parse('/edge/auth/gift');
+$m = MojoX::Routes::Match->new($tx)->match($r);
+is $m->stack->[0]->{controller}, 'auth', 'right value';
+is $m->stack->[0]->{action}, 'check', 'right value';
+is $m->stack->[0]->{format}, undef, 'no value';
+is $m->stack->[1]->{controller}, 'gift', 'right value';
+is $m->stack->[1]->{action}, 'index', 'right value';
+is $m->stack->[1]->{format}, undef, 'no value';
+is $m->stack->[2], undef, 'no value';
+is $m->url_for, '/edge/auth/gift', 'right URL';
+is $m->url_for('gift'), '/edge/auth/gift', 'right URL';
+is $m->url_for('current'), '/edge/auth/gift', 'right URL';
+is @{$m->stack}, 2, 'right number of elements';
@@ -10,6 +10,15 @@ plan skip_all => 'Test::Pod::Coverage 1.04 required for this test!' if $@;
plan skip_all => 'set TEST_POD to enable this test (developer only!)'
unless $ENV{TEST_POD};
+# DEPRECATED in Comet!
+my @client = qw/max_keep_alive_connections process/;
+my @ioloop = qw/error_cb hup_cb idle_cb lock_cb read_cb tick_cb unlock_cb/;
+my @message = qw/finish_cb progress_cb/;
+my @server =
+ qw/build_tx_cb handler_cb max_keep_alive_requests websocket_handshake_cb/;
+my @tx = qw/finished helper receive_message resume_cb upgrade_cb/;
+
# Marge, I'm going to miss you so much. And it's not just the sex.
# It's also the food preparation.
-all_pod_coverage_ok();
+all_pod_coverage_ok(
+ {also_private => [@client, @ioloop, @message, @server, @tx]});